IDE.MainForm.pas 243 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628
  1. unit IDE.MainForm;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2026 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Compiler form
  8. }
  9. {x$DEFINE STATICCOMPILER}
  10. { For debugging purposes, remove the 'x' to have it link the compiler code into
  11. this program and not depend on ISCmplr.dll. You will also need to add the
  12. ..\Components and Src folders to the Delphi Compiler Search path in the project
  13. options. Also see ISCC's STATICCOMPILER and Compiler.Compile's STATICPREPROC. }
  14. {$IFDEF STATICCOMPILER}
  15. {$R ..\Res\ISCmplr.images.res}
  16. {$ENDIF}
  17. interface
  18. uses
  19. Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms, Dialogs, CommDlg,
  20. Generics.Collections, UIStateForm, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, CommCtrl,
  21. ScintInt, ScintEdit, IDE.ScintStylerInnoSetup, NewTabSet, ModernColors, IDE.IDEScintEdit,
  22. Shared.DebugStruct, Shared.CompilerInt.Struct, NewUxTheme, ImageList, ImgList, ToolWin, IDE.HelperFunc,
  23. VirtualImageList, BaseImageCollection, BitmapButton;
  24. const
  25. WM_StartCommandLineCompile = WM_USER + $1000;
  26. WM_StartCommandLineWizard = WM_USER + $1001;
  27. WM_StartNormally = WM_USER + $1002;
  28. type
  29. PDebugEntryArray = ^TDebugEntryArray;
  30. TDebugEntryArray = array[0..0] of TDebugEntry;
  31. PVariableDebugEntryArray = ^TVariableDebugEntryArray;
  32. TVariableDebugEntryArray = array[0..0] of TVariableDebugEntry;
  33. TStepMode = (smRun, smStepInto, smStepOver, smStepOut, smRunToCursor);
  34. TDebugTarget = (dtSetup, dtUninstall);
  35. const
  36. DebugTargetStrings: array[TDebugTarget] of String = ('Setup', 'Uninstall');
  37. const
  38. MRUListMaxCount = 10;
  39. { Status bar panel indexes }
  40. spCaretPos = 0;
  41. spModified = 1;
  42. spEditMode = 2;
  43. spFindRegEx = 3;
  44. spHiddenFilesCount = 4;
  45. spCompileIcon = 5;
  46. spCompileProgress = 6;
  47. spExtraStatus = 7;
  48. { Output tab set indexes }
  49. tiCompilerOutput = 0;
  50. tiDebugOutput = 1;
  51. tiDebugCallStack = 2;
  52. tiFindResults = 3;
  53. type
  54. TStatusMessageKind = (smkStartEnd, smkNormal, smkWarning, smkError);
  55. TIncludedFile = class
  56. Filename: String;
  57. CompilerFileIndex: Integer;
  58. LastWriteTime: TFileTime;
  59. HasLastWriteTime: Boolean;
  60. Memo: TIDEScintFileEdit; { nil if the amount of #include files (visible or hidden) is more than MaxMemos allows }
  61. end;
  62. TIncludedFiles = TObjectList<TIncludedFile>;
  63. TFindResult = class
  64. Filename: String;
  65. Line, LineStartPos: Integer;
  66. Range: TScintRange;
  67. PrefixStringLength: Integer;
  68. end;
  69. TFindResults = TObjectList<TFindResult>;
  70. TMenuBitmaps = TDictionary<TMenuItem, HBITMAP>;
  71. TKeyMappedMenus = TDictionary<TShortCut, TToolButton>;
  72. TCallTipState = record
  73. StartCallTipWord: Integer;
  74. FunctionDefinition: AnsiString;
  75. BraceCount: Integer;
  76. LastPosCallTip: Integer;
  77. ClassOrRecordMember: Boolean;
  78. CurrentCallTipWord: String;
  79. CurrentCallTip: Integer;
  80. MaxCallTips: Integer;
  81. end;
  82. TUpdatePanelMessage = class
  83. Msg, ConfigIdent: String;
  84. ConfigValue: Integer;
  85. Color: TColor;
  86. HasLink: Boolean;
  87. constructor Create(const AMsg, AConfigIdent: String; const AConfigValue: Integer; const AColor: TColor; const AHasLink: Boolean);
  88. end;
  89. TUpdatePanelMessages = TObjectList<TUpdatePanelMessage>;
  90. TOptions = record
  91. ShowStartupForm: Boolean;
  92. UseWizard: Boolean;
  93. Autosave: Boolean;
  94. Autoreload: Boolean;
  95. MakeBackups: Boolean;
  96. FullPathInTitleBar: Boolean;
  97. UndoAfterSave: Boolean;
  98. UndoAfterReload: Boolean;
  99. PauseOnDebuggerExceptions: Boolean;
  100. RunAsDifferentUser: Boolean;
  101. AutoAutoComplete: Boolean;
  102. AutoCallTips: Boolean;
  103. UseSyntaxHighlighting: Boolean;
  104. ColorizeCompilerOutput: Boolean;
  105. UnderlineErrors: Boolean;
  106. HighlightWordAtCursorOccurrences: Boolean;
  107. HighlightSelTextOccurrences: Boolean;
  108. CursorPastEOL: Boolean;
  109. TabWidth: Integer;
  110. UseTabCharacter: Boolean;
  111. ShowWhiteSpace: Boolean;
  112. SmartHome: Boolean;
  113. UseFolding: Boolean;
  114. FindRegEx: Boolean;
  115. WordWrap: Boolean;
  116. AutoIndent: Boolean;
  117. IndentationGuides: Boolean;
  118. LowPriorityDuringCompile: Boolean;
  119. GutterLineNumbers: Boolean;
  120. KeyMappingType: TKeyMappingType;
  121. MemoKeyMappingType: TIDEScintKeyMappingType;
  122. ThemeType: TThemeType;
  123. ShowPreprocessorOutput: Boolean;
  124. OpenIncludedFiles: Boolean;
  125. AutoHideNewIncludedFiles: Boolean;
  126. ShowCaretPosition: Boolean;
  127. end;
  128. TMainForm = class(TUIStateForm)
  129. MainMenu1: TMainMenu;
  130. FMenu: TMenuItem;
  131. FNewMainFile: TMenuItem;
  132. FOpenMainFile: TMenuItem;
  133. FSave: TMenuItem;
  134. FSaveMainFileAs: TMenuItem;
  135. N1: TMenuItem;
  136. BCompile: TMenuItem;
  137. N2: TMenuItem;
  138. FExit: TMenuItem;
  139. EMenu: TMenuItem;
  140. EUndo: TMenuItem;
  141. N3: TMenuItem;
  142. ECut: TMenuItem;
  143. ECopy: TMenuItem;
  144. EPaste: TMenuItem;
  145. EDelete: TMenuItem;
  146. N4: TMenuItem;
  147. ESelectAll: TMenuItem;
  148. VMenu: TMenuItem;
  149. EFind: TMenuItem;
  150. EFindNext: TMenuItem;
  151. EReplace: TMenuItem;
  152. HMenu: TMenuItem;
  153. HDoc: TMenuItem;
  154. HAbout: TMenuItem;
  155. FRecent: TMenuItem;
  156. FClearRecent: TMenuItem;
  157. N6: TMenuItem;
  158. VCompilerOutput: TMenuItem;
  159. FindDialog: TFindDialog;
  160. ReplaceDialog: TReplaceDialog;
  161. StatusPanel: TPanel;
  162. CompilerOutputList: TListBox;
  163. SplitPanel: TPanel;
  164. HWebsite: TMenuItem;
  165. VToolbar: TMenuItem;
  166. N7: TMenuItem;
  167. TOptions: TMenuItem;
  168. HFaq: TMenuItem;
  169. StatusBar: TStatusBar;
  170. BodyPanel: TPanel;
  171. VStatusBar: TMenuItem;
  172. ERedo: TMenuItem;
  173. RMenu: TMenuItem;
  174. RStepInto: TMenuItem;
  175. RStepOver: TMenuItem;
  176. N5: TMenuItem;
  177. RRun: TMenuItem;
  178. RRunToCursor: TMenuItem;
  179. N10: TMenuItem;
  180. REvaluate: TMenuItem;
  181. CheckIfTerminatedTimer: TTimer;
  182. RPause: TMenuItem;
  183. RParameters: TMenuItem;
  184. OutputListPopupMenu: TMenuItem;
  185. POutputListCopy: TMenuItem;
  186. HISPPSep: TMenuItem;
  187. N12: TMenuItem;
  188. BStopCompile: TMenuItem;
  189. HISPPDoc: TMenuItem;
  190. N13: TMenuItem;
  191. EGotoLine: TMenuItem;
  192. RTerminate: TMenuItem;
  193. BMenu: TMenuItem;
  194. BLowPriority: TMenuItem;
  195. HPurchase: TMenuItem;
  196. HRegister: TMenuItem;
  197. HUnregister: TMenuItem;
  198. HDonate: TMenuItem;
  199. N14: TMenuItem;
  200. N15: TMenuItem;
  201. RTargetSetup: TMenuItem;
  202. RTargetUninstall: TMenuItem;
  203. OutputTabSet: TNewTabSet;
  204. DebugOutputList: TListBox;
  205. VDebugOutput: TMenuItem;
  206. VHide: TMenuItem;
  207. N11: TMenuItem;
  208. TMenu: TMenuItem;
  209. TAddRemovePrograms: TMenuItem;
  210. RToggleBreakPoint: TMenuItem;
  211. RDeleteBreakPoints: TMenuItem;
  212. HWhatsNew: TMenuItem;
  213. TGenerateGUID: TMenuItem;
  214. TSignTools: TMenuItem;
  215. N16: TMenuItem;
  216. HExamples: TMenuItem;
  217. N17: TMenuItem;
  218. BOpenOutputFolder: TMenuItem;
  219. N8: TMenuItem;
  220. VZoom: TMenuItem;
  221. VZoomIn: TMenuItem;
  222. VZoomOut: TMenuItem;
  223. N9: TMenuItem;
  224. VZoomReset: TMenuItem;
  225. N18: TMenuItem;
  226. N19: TMenuItem;
  227. FSaveEncoding: TMenuItem;
  228. FSaveEncodingAuto: TMenuItem;
  229. FSaveEncodingUTF8WithBOM: TMenuItem;
  230. ToolBar: TToolBar;
  231. BackNavButton: TToolButton;
  232. ForwardNavButton: TToolButton;
  233. ToolButton1: TToolButton;
  234. NewMainFileButton: TToolButton;
  235. OpenMainFileButton: TToolButton;
  236. SaveButton: TToolButton;
  237. ToolButton2: TToolButton;
  238. CompileButton: TToolButton;
  239. StopCompileButton: TToolButton;
  240. ToolButton3: TToolButton;
  241. RunButton: TToolButton;
  242. PauseButton: TToolButton;
  243. ToolButton4: TToolButton;
  244. TargetSetupButton: TToolButton;
  245. TargetUninstallButton: TToolButton;
  246. ToolButton5: TToolButton;
  247. HelpButton: TToolButton;
  248. Bevel1: TBevel;
  249. TerminateButton: TToolButton;
  250. ThemedToolbarVirtualImageList: TVirtualImageList;
  251. LightToolbarVirtualImageList: TVirtualImageList;
  252. POutputListSelectAll: TMenuItem;
  253. DebugCallStackList: TListBox;
  254. VDebugCallStack: TMenuItem;
  255. TMsgBoxDesigner: TMenuItem;
  256. TRegistryDesigner: TMenuItem;
  257. ToolBarPanel: TPanel;
  258. HMailingList: TMenuItem;
  259. MemosTabSet: TNewTabSet; { First tab is the main memo, last tab is the preprocessor output memo }
  260. FSaveAll: TMenuItem;
  261. RStepOut: TMenuItem;
  262. VNextTab: TMenuItem;
  263. VPreviousTab: TMenuItem;
  264. N20: TMenuItem;
  265. HShortcutsDoc: TMenuItem;
  266. HRegExDoc: TMenuItem;
  267. N21: TMenuItem;
  268. EFindPrevious: TMenuItem;
  269. FindResultsList: TListBox;
  270. VFindResults: TMenuItem;
  271. EFindInFiles: TMenuItem;
  272. FindInFilesDialog: TFindDialog;
  273. FPrint: TMenuItem;
  274. N22: TMenuItem;
  275. PrintDialog: TPrintDialog;
  276. FSaveEncodingUTF8WithoutBOM: TMenuItem;
  277. TFilesDesigner: TMenuItem;
  278. VCloseCurrentTab: TMenuItem;
  279. VReopenTab: TMenuItem;
  280. VReopenTabs: TMenuItem;
  281. MemosTabSetPopupMenu: TMenuItem;
  282. VCloseCurrentTab2: TMenuItem;
  283. VReopenTab2: TMenuItem;
  284. VReopenTabs2: TMenuItem;
  285. NavPopupMenu: TMenuItem;
  286. N23: TMenuItem;
  287. ThemedMarkersAndACVirtualImageList: TVirtualImageList;
  288. ESelectNextOccurrence: TMenuItem;
  289. ESelectAllOccurrences: TMenuItem;
  290. BreakPointsPopupMenu: TMenuItem;
  291. RToggleBreakPoint2: TMenuItem;
  292. RDeleteBreakPoints2: TMenuItem;
  293. N24: TMenuItem;
  294. VWordWrap: TMenuItem;
  295. N25: TMenuItem;
  296. ESelectAllFindMatches: TMenuItem;
  297. EToggleLinesComment: TMenuItem;
  298. EBraceMatch: TMenuItem;
  299. EFoldLine: TMenuItem;
  300. EUnfoldLine: TMenuItem;
  301. EFindRegEx: TMenuItem;
  302. UpdatePanel: TPanel;
  303. UpdateLinkLabel: TLinkLabel;
  304. UpdatePanelCloseBitBtn: TBitmapButton;
  305. UpdatePanelDonateBitBtn: TBitmapButton;
  306. EGotoFile: TMenuItem;
  307. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  308. procedure FExitClick(Sender: TObject);
  309. procedure FOpenMainFileClick(Sender: TObject);
  310. procedure EUndoClick(Sender: TObject);
  311. procedure EMenuClick(Sender: TObject);
  312. procedure ECutClick(Sender: TObject);
  313. procedure ECopyClick(Sender: TObject);
  314. procedure EPasteClick(Sender: TObject);
  315. procedure EDeleteClick(Sender: TObject);
  316. procedure FSaveClick(Sender: TObject);
  317. procedure ESelectAllClick(Sender: TObject);
  318. procedure FNewMainFileClick(Sender: TObject);
  319. procedure FNewMainFileUserWizardClick(Sender: TObject);
  320. procedure HDocClick(Sender: TObject);
  321. procedure BCompileClick(Sender: TObject);
  322. procedure FMenuClick(Sender: TObject);
  323. procedure FMRUClick(Sender: TObject);
  324. procedure VCompilerOutputClick(Sender: TObject);
  325. procedure HAboutClick(Sender: TObject);
  326. procedure EFindClick(Sender: TObject);
  327. procedure FindDialogFind(Sender: TObject);
  328. procedure EReplaceClick(Sender: TObject);
  329. procedure ReplaceDialogReplace(Sender: TObject);
  330. procedure EFindNextOrPreviousClick(Sender: TObject);
  331. procedure SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  332. Y: Integer);
  333. procedure VMenuClick(Sender: TObject);
  334. procedure HWebsiteClick(Sender: TObject);
  335. procedure VToolbarClick(Sender: TObject);
  336. procedure TOptionsClick(Sender: TObject);
  337. procedure HFaqClick(Sender: TObject);
  338. procedure HISPPDocClick(Sender: TObject);
  339. procedure VStatusBarClick(Sender: TObject);
  340. procedure ERedoClick(Sender: TObject);
  341. procedure StatusBarResize(Sender: TObject);
  342. procedure RStepIntoClick(Sender: TObject);
  343. procedure RStepOverClick(Sender: TObject);
  344. procedure RRunToCursorClick(Sender: TObject);
  345. procedure RRunClick(Sender: TObject);
  346. procedure REvaluateClick(Sender: TObject);
  347. procedure CheckIfTerminatedTimerTimer(Sender: TObject);
  348. procedure RPauseClick(Sender: TObject);
  349. procedure RParametersClick(Sender: TObject);
  350. procedure POutputListCopyClick(Sender: TObject);
  351. procedure BStopCompileClick(Sender: TObject);
  352. procedure EGotoLineClick(Sender: TObject);
  353. procedure RTerminateClick(Sender: TObject);
  354. procedure BMenuClick(Sender: TObject);
  355. procedure BLowPriorityClick(Sender: TObject);
  356. procedure StatusBarDrawPanel(StatusBar: TStatusBar;
  357. Panel: TStatusPanel; const Rect: TRect);
  358. procedure HPurchaseClick(Sender: TObject);
  359. procedure HRegisterClick(Sender: TObject);
  360. procedure HUnregisterClick(Sender: TObject);
  361. procedure HDonateClick(Sender: TObject);
  362. procedure RTargetClick(Sender: TObject);
  363. procedure DebugOutputListDrawItem(Control: TWinControl; Index: Integer;
  364. Rect: TRect; State: TOwnerDrawState);
  365. procedure OutputTabSetClick(Sender: TObject);
  366. procedure VHideClick(Sender: TObject);
  367. procedure VDebugOutputClick(Sender: TObject);
  368. procedure FormResize(Sender: TObject);
  369. procedure TAddRemoveProgramsClick(Sender: TObject);
  370. procedure RToggleBreakPointClick(Sender: TObject);
  371. procedure RDeleteBreakPointsClick(Sender: TObject);
  372. procedure HWhatsNewClick(Sender: TObject);
  373. procedure TGenerateGUIDClick(Sender: TObject);
  374. procedure TSignToolsClick(Sender: TObject);
  375. procedure HExamplesClick(Sender: TObject);
  376. procedure BOpenOutputFolderClick(Sender: TObject);
  377. procedure FormKeyDown(Sender: TObject; var Key: Word;
  378. Shift: TShiftState);
  379. procedure VZoomInClick(Sender: TObject);
  380. procedure VZoomOutClick(Sender: TObject);
  381. procedure VZoomResetClick(Sender: TObject);
  382. procedure FSaveEncodingItemClick(Sender: TObject);
  383. procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer;
  384. Rect: TRect; State: TOwnerDrawState);
  385. procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  386. NewDPI: Integer);
  387. procedure POutputListSelectAllClick(Sender: TObject);
  388. procedure DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  389. State: TOwnerDrawState);
  390. procedure VDebugCallStackClick(Sender: TObject);
  391. procedure HMailingListClick(Sender: TObject);
  392. procedure TMsgBoxDesignerClick(Sender: TObject);
  393. procedure TRegistryDesignerClick(Sender: TObject);
  394. procedure MemosTabSetClick(Sender: TObject);
  395. procedure FSaveAllClick(Sender: TObject);
  396. procedure RStepOutClick(Sender: TObject);
  397. procedure TMenuClick(Sender: TObject);
  398. procedure VNextTabClick(Sender: TObject);
  399. procedure VPreviousTabClick(Sender: TObject);
  400. procedure HShortcutsDocClick(Sender: TObject);
  401. procedure HRegExDocClick(Sender: TObject);
  402. procedure VFindResultsClick(Sender: TObject);
  403. procedure EFindInFilesClick(Sender: TObject);
  404. procedure FindInFilesDialogFind(Sender: TObject);
  405. procedure FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  406. State: TOwnerDrawState);
  407. procedure FindResultsListDblClick(Sender: TObject);
  408. procedure FPrintClick(Sender: TObject);
  409. procedure TFilesDesignerClick(Sender: TObject);
  410. procedure VCloseCurrentTabClick(Sender: TObject);
  411. procedure VReopenTabsClick(Sender: TObject);
  412. procedure MemosTabSetPopupMenuClick(Sender: TObject);
  413. procedure MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
  414. procedure StatusBarClick(Sender: TObject);
  415. procedure SimpleMenuClick(Sender: TObject);
  416. procedure OutputListKeyDown(Sender: TObject; var Key: Word;
  417. Shift: TShiftState);
  418. procedure RMenuClick(Sender: TObject);
  419. procedure BackNavButtonClick(Sender: TObject);
  420. procedure ForwardNavButtonClick(Sender: TObject);
  421. procedure NavPopupMenuClick(Sender: TObject);
  422. procedure ESelectNextOccurrenceClick(Sender: TObject);
  423. procedure ESelectAllOccurrencesClick(Sender: TObject);
  424. procedure BreakPointsPopupMenuClick(Sender: TObject);
  425. procedure FClearRecentClick(Sender: TObject);
  426. procedure VWordWrapClick(Sender: TObject);
  427. procedure ESelectAllFindMatchesClick(Sender: TObject);
  428. procedure EToggleLinesCommentClick(Sender: TObject);
  429. procedure EBraceMatchClick(Sender: TObject);
  430. procedure EFoldOrUnfoldLineClick(Sender: TObject);
  431. procedure EFindRegExClick(Sender: TObject);
  432. procedure UpdateLinkLabelLinkClick(Sender: TObject; const Link: string;
  433. LinkType: TSysLinkType);
  434. procedure UpdatePanelCloseBitBtnPaint(Sender: TObject; Canvas: TCanvas; var ARect: TRect);
  435. procedure UpdatePanelCloseBitBtnClick(Sender: TObject);
  436. procedure UpdatePanelDonateBitBtnClick(Sender: TObject);
  437. procedure HMenuClick(Sender: TObject);
  438. procedure EGotoFileClick(Sender: TObject);
  439. private
  440. FCompilerVersion: PCompilerVersionInfo;
  441. FOptionsLoaded: Boolean;
  442. FCompileWantAbort: Boolean;
  443. FBecameIdle: Boolean;
  444. FModifiedAnySinceLastCompile, FModifiedAnySinceLastCompileAndGo: Boolean;
  445. FDebugEntries: PDebugEntryArray;
  446. FDebugEntriesCount: Integer;
  447. FVariableDebugEntries: PVariableDebugEntryArray;
  448. FVariableDebugEntriesCount: Integer;
  449. FCompiledCodeText: AnsiString;
  450. FCompiledCodeDebugInfo: AnsiString;
  451. FProcessHandle, FDebugClientProcessHandle: THandle;
  452. FUninstExe, FTempDir: String;
  453. FPreprocessorOutput: String;
  454. FIncludedFiles: TIncludedFiles; { All include files *including* hidden ones }
  455. FStepMode: TStepMode;
  456. FPausedAtCodeLine: Boolean;
  457. FRunToCursorPoint: TDebugEntry;
  458. FReplyString: String;
  459. FDebuggerException: String;
  460. FRunParameters: String;
  461. FLastEvaluateConstantText: String;
  462. FSavePriorityClass: DWORD;
  463. FBuildAnimationFrame: Integer;
  464. FLastAnimationTick: DWORD;
  465. FProgress, FProgressMax: Cardinal;
  466. FTaskbarProgressValue: Cardinal;
  467. FProgressThemeData: HTHEME;
  468. FToolbarThemeData: HTHEME;
  469. FStatusBarThemeData: HTHEME;
  470. FDebugLogListTimestampsWidth: Integer;
  471. FOnPendingSquiggly: Boolean;
  472. FPendingSquigglyCaretPos: Integer;
  473. FCallStackCount: Cardinal;
  474. FDevMode, FDevNames: HGLOBAL;
  475. FSynchingZoom: Boolean;
  476. FKeyMappedMenus: TKeyMappedMenus;
  477. FBackNavButtonShortCut, FForwardNavButtonShortCut: TShortCut;
  478. FBackNavButtonShortCut2, FForwardNavButtonShortCut2: TShortCut;
  479. FIgnoreTabSetClick: Boolean;
  480. FFirstTabSelectShortCut, FLastTabSelectShortCut: TShortCut;
  481. FCompileShortCut2: TShortCut;
  482. FUpdatePanelMessages: TUpdatePanelMessages;
  483. FHighContrastActive: Boolean;
  484. FDonateImageMenuItem: TMenuItem;
  485. procedure AppOnActivate(Sender: TObject);
  486. class procedure AppOnGetActiveFormHandle(var AHandle: HWND);
  487. procedure AppOnIdle(Sender: TObject; var Done: Boolean);
  488. function AskToDetachDebugger: Boolean;
  489. procedure BringToForeground;
  490. procedure BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
  491. procedure BuildAndSaveKnownIncludedAndHiddenFiles;
  492. procedure CloseTab(const TabIndex: Integer);
  493. procedure CompileFile(AFilename: String; const ReadFromFile: Boolean);
  494. procedure CompileIfNecessary;
  495. function ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
  496. procedure DebuggingStopped(const WaitForTermination: Boolean);
  497. procedure DebugLogMessage(const S: String);
  498. procedure DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
  499. function DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
  500. procedure DestroyDebugInfo;
  501. procedure DetachDebugger;
  502. function EvaluateConstant(const S: String; out Output: String): Integer;
  503. function EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
  504. out Output: String): Integer;
  505. function GetBorderStyle: TFormBorderStyle;
  506. procedure Go(const AStepMode: TStepMode);
  507. procedure HideError;
  508. function InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  509. function InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  510. function InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  511. function InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  512. procedure InvalidateStatusPanel(const Index: Integer);
  513. procedure LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
  514. procedure LoadKnownIncludedAndHiddenFilesAndUpdateMemos(const AFilename: String);
  515. procedure MemoCallTipArrowClick(Sender: TObject; const Up: Boolean);
  516. procedure MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
  517. procedure MemoCharAdded(Sender: TObject; Ch: AnsiChar);
  518. procedure MainMemoDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings);
  519. procedure MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
  520. procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  521. procedure MemoKeyPress(Sender: TObject; var Key: Char);
  522. procedure MemoMarginClick(Sender: TObject; MarginNumber: Integer;
  523. Line: Integer);
  524. procedure MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
  525. Line: Integer);
  526. procedure MemoModifiedChange(Sender: TObject);
  527. procedure MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
  528. procedure MemoZoom(Sender: TObject);
  529. procedure NewMainFile(const IsReload: Boolean = False);
  530. procedure NewMainFileUsingWizard;
  531. procedure OpenFile(AMemo: TIDEScintFileEdit; AFilename: String; const MainMemoAddToRecentDocs: Boolean;
  532. const IsReload: Boolean = False);
  533. procedure OpenMRUMainFile(const AFilename: String);
  534. procedure ParseDebugInfo(DebugInfo: Pointer);
  535. procedure ReopenTabOrTabs(const HiddenFileIndex: Integer; const Activate: Boolean);
  536. procedure ResetAllMemosLineState;
  537. function SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
  538. procedure SetBorderStyle(Value: TFormBorderStyle);
  539. procedure SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
  540. procedure SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
  541. procedure ShowOpenMainFileDialog(const Examples: Boolean);
  542. procedure StatusBarCanvasDrawPanel(Canvas: TCanvas;
  543. Panel: TStatusPanel; const Rect: TRect);
  544. procedure StatusMessage(const Kind: TStatusMessageKind; const S: String);
  545. procedure SyncEditorOptions;
  546. function TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
  547. procedure ToggleBreakPoint(Line: Integer);
  548. procedure UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
  549. procedure UpdateAllMemosLineMarkers;
  550. procedure UpdateBevel1Visibility;
  551. procedure UpdateCaption;
  552. procedure UpdateCaretPosPanelAndBackNavStack;
  553. procedure UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal;
  554. const ASecondsRemaining: Integer; const ABytesCompressedPerSecond: Cardinal);
  555. procedure UpdateEditModeStatusPanel;
  556. procedure UpdateFindRegExUI;
  557. procedure UpdatePreprocMemos(const DontUpdateRelatedVisibilty: Boolean = False);
  558. procedure UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
  559. procedure UpdateImages;
  560. procedure UpdateMarginsAndAutoCompleteIcons;
  561. procedure UpdateMarginsAndSquigglyAndCaretWidths;
  562. procedure UpdateMemosTabSetVisibility;
  563. procedure UpdateModifiedStatusPanel;
  564. procedure UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
  565. procedure UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  566. procedure UpdateUpdatePanel;
  567. procedure UpdateKeyMapping;
  568. procedure UpdateTheme;
  569. procedure UpdateThemeData(const Open: Boolean);
  570. procedure UpdateStatusPanelHeight(H: Integer);
  571. procedure WMAppCommand(var Message: TMessage); message WM_APPCOMMAND;
  572. procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
  573. procedure WMDebuggerHello(var Message: TMessage); message WM_Debugger_Hello;
  574. procedure WMDebuggerGoodbye(var Message: TMessage); message WM_Debugger_Goodbye;
  575. procedure WMDebuggerQueryVersion(var Message: TMessage); message WM_Debugger_QueryVersion;
  576. procedure GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit;
  577. var DebugEntry: PDebugEntry);
  578. procedure DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
  579. procedure WMDebuggerStepped(var Message: TMessage); message WM_Debugger_Stepped;
  580. procedure WMDebuggerSteppedIntermediate(var Message: TMessage); message WM_Debugger_SteppedIntermediate;
  581. procedure WMDebuggerException(var Message: TMessage); message WM_Debugger_Exception;
  582. procedure WMDebuggerSetForegroundWindow(var Message: TMessage); message WM_Debugger_SetForegroundWindow;
  583. procedure WMDebuggerCallStackCount(var Message: TMessage); message WM_Debugger_CallStackCount;
  584. procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile;
  585. procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard;
  586. procedure WMStartNormally(var Message: TMessage); message WM_StartNormally;
  587. procedure WMDPIChanged(var Message: TMessage); message WM_DPICHANGED;
  588. procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
  589. procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
  590. procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
  591. procedure WMUAHDrawMenu(var Message: TMessage); message WM_UAHDRAWMENU;
  592. procedure WMUAHDrawMenuItem(var Message: TMessage); message WM_UAHDRAWMENUITEM;
  593. procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE;
  594. procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  595. protected
  596. { Main objects }
  597. FMemos: TList<TIDEScintEdit>; { FMemos[0] is the main memo and FMemos[1] the preprocessor output memo - also see MemosTabSet comment above
  598. Note that hidden files also use a memo }
  599. FMainMemo: TIDEScintFileEdit; { Doesn't change }
  600. FPreprocessorOutputMemo: TIDEScintEdit; { Doesn't change and is the only memo which isnt a TIDEScint*File*Edit}
  601. FFileMemos: TList<TIDEScintFileEdit>; { All memos except FPreprocessorOutputMemo, including those without a tab }
  602. FHiddenFiles: TStringList; { List of files which *do* use a memo but are hidden by the user and have no tab }
  603. FActiveMemo: TIDEScintEdit; { Changes depending on user input }
  604. FErrorMemo, FStepMemo: TIDEScintFileEdit; { These change depending on user input }
  605. FMemosStyler: TInnoSetupStyler; { Single styler for all memos }
  606. { Used by class helpers }
  607. FCallTipState: TCallTipState;
  608. FCompiledExe: String;
  609. FCompiling: Boolean;
  610. FCurrentNavItem: TIDEScintEditNavItem;
  611. FDebugClientWnd: HWND;
  612. FDebugging: Boolean;
  613. FDebugTarget: TDebugTarget;
  614. FFindResults: TFindResults;
  615. FLastFindOptions: TFindOptions;
  616. FLastFindRegEx: Boolean;
  617. FLastFindText: String;
  618. FLastReplaceText: String;
  619. FMenuImageList: TVirtualImageList;
  620. FMenuBitmaps: TMenuBitmaps;
  621. FMenuBitmapsSize: TSize;
  622. FMenuBitmapsSourceImageCollection: TCustomImageCollection;
  623. FMRUMainFilesList: TStringList;
  624. FMRUMainFilesMenuItems: array[0..MRUListMaxCount-1] of TMenuItem;
  625. FMRUParametersList: TStringList;
  626. FMenuDarkBackgroundBrush: TBrush;
  627. FMenuDarkHotOrSelectedBrush: TBrush;
  628. FMenuThemeData: HTHEME;
  629. FNavStacks: TIDEScintEditNavStacks;
  630. FOptions: TOptions;
  631. FPaused: Boolean;
  632. FSignTools: TStringList;
  633. FTheme: TTheme;
  634. procedure CheckIfTerminated;
  635. function MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
  636. procedure MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
  637. const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean;
  638. const IsPosition: Boolean = False; const PositionVirtualSpace: Integer = 0);
  639. procedure ReopenTabClick(Sender: TObject);
  640. procedure SetStatusPanelVisible(const AVisible: Boolean);
  641. { Other }
  642. procedure WndProc(var Message: TMessage); override;
  643. public
  644. constructor Create(AOwner: TComponent); override;
  645. destructor Destroy; override;
  646. function IsShortCut(var Message: TWMKey): Boolean; override;
  647. published
  648. property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle;
  649. end;
  650. var
  651. MainForm: TMainForm;
  652. CommandLineFilename, CommandLineWizardName: String;
  653. CommandLineCompile: Boolean;
  654. CommandLineWizard: Boolean;
  655. implementation
  656. uses
  657. ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes, Themes, DateUtils,
  658. Math, StrUtils, WideStrUtils, TypInfo,
  659. PathFunc, TaskbarProgressFunc, NewUxTheme.TmSchema, BrowseFunc, UnsignedFunc,
  660. Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, Shared.ScriptFunc,
  661. {$IFDEF STATICCOMPILER} Compiler.Compile, {$ENDIF}
  662. IDE.Messages, IDE.HtmlHelpFunc, IDE.ImagesModule,
  663. IDE.OptionsForm, IDE.StartupForm, IDE.Wizard.WizardForm, IDE.GotoFileForm,
  664. IDE.InputQueryComboForm, IDE.LicenseKeyForm, IDE.MainForm.FinalHelper,
  665. Shared.ConfigIniFile, Shared.SignToolsFunc, Shared.CompilerInt, Shared.LicenseFunc;
  666. {$R *.DFM}
  667. const
  668. { Memos }
  669. MaxMemos = 52; { Includes the main and preprocessor output memos }
  670. FirstIncludedFilesMemoIndex = 1; { This is an index into FFileMemos }
  671. LineStateGrowAmount = 4000;
  672. { TUpdatePanelMessage }
  673. constructor TUpdatePanelMessage.Create(const AMsg, AConfigIdent: String;
  674. const AConfigValue: Integer; const AColor: TColor; const AHasLink: Boolean);
  675. begin
  676. Msg := AMsg;
  677. ConfigIdent := AConfigIdent;
  678. ConfigValue := AConfigValue;
  679. Color := AColor;
  680. HasLink := AHasLink;
  681. end;
  682. { TMainFormPopupMenu }
  683. type
  684. TMainFormPopupMenu = class(TPopupMenu)
  685. private
  686. FParentMenuItem: TMenuItem;
  687. public
  688. constructor Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem); reintroduce; virtual;
  689. procedure Popup(X, Y: Integer); override;
  690. end;
  691. constructor TMainFormPopupMenu.Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem);
  692. begin
  693. inherited Create(AOwner);
  694. FParentMenuItem := ParentMenuItem;
  695. end;
  696. procedure TMainFormPopupMenu.Popup(X, Y: Integer);
  697. var
  698. Form: TMainForm;
  699. begin
  700. { Show the existing main menu's submenu }
  701. Form := Owner as TMainForm;
  702. var OldVisible := FParentMenuItem.Visible; { See ApplyMenuBitmaps }
  703. FParentMenuItem.Visible := True;
  704. try
  705. TrackPopupMenu(FParentMenuItem.Handle, TPM_RIGHTBUTTON, X, Y, 0, Form.Handle, nil);
  706. finally
  707. FParentMenuItem.Visible := OldVisible;
  708. end;
  709. end;
  710. { TMainForm }
  711. function TMainForm.InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  712. begin
  713. Memo.Align := alClient;
  714. Memo.Font.Name := GetPreferredMemoFont; { Default font only, see ReadConfig }
  715. Memo.Font.Size := 10;
  716. Memo.ShowHint := True;
  717. Memo.Styler := FMemosStyler;
  718. Memo.PopupMenu := PopupMenu;
  719. Memo.OnCallTipArrowClick := MemoCallTipArrowClick;
  720. Memo.OnChange := MemoChange;
  721. Memo.OnCharAdded := MemoCharAdded;
  722. Memo.OnHintShow := MemoHintShow;
  723. Memo.OnKeyDown := MemoKeyDown;
  724. Memo.OnKeyPress := MemoKeyPress;
  725. Memo.OnMarginClick := MemoMarginClick;
  726. Memo.OnMarginRightClick := MemoMarginRightClick;
  727. Memo.OnModifiedChange := MemoModifiedChange;
  728. Memo.OnUpdateUI := MemoUpdateUI;
  729. Memo.OnZoom := MemoZoom;
  730. Memo.Parent := BodyPanel;
  731. Memo.SetAutoCompleteSeparators(InnoSetupStylerWordListSeparator, InnoSetupStylerWordListTypeSeparator);
  732. Memo.SetWordChars(Memo.GetDefaultWordChars+'#{}[]');
  733. Memo.Theme := FTheme;
  734. Memo.StyleName := 'Windows';
  735. Memo.Visible := False;
  736. Result := Memo;
  737. end;
  738. function TMainForm.InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  739. begin
  740. InitializeMemoBase(Memo, PopupMenu);
  741. Memo.ChangeHistory := schMarkers;
  742. Memo.CompilerFileIndex := UnknownCompilerFileIndex;
  743. Memo.ErrorLine := -1;
  744. Memo.StepLine := -1;
  745. Result := Memo;
  746. end;
  747. function TMainForm.InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  748. begin
  749. InitializeFileMemo(Memo, PopupMenu);
  750. Memo.AcceptDroppedFiles := True;
  751. Memo.CompilerFileIndex := -1;
  752. Memo.OnDropFiles := MainMemoDropFiles;
  753. Memo.Used := True;
  754. Result := Memo;
  755. end;
  756. function TMainForm.InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  757. begin
  758. InitializeMemoBase(Memo, PopupMenu);
  759. Memo.ReadOnly := True;
  760. Result := Memo;
  761. end;
  762. constructor TMainForm.Create(AOwner: TComponent);
  763. procedure CheckUpdatePanelMessage(const Ini: TConfigIniFile; const ConfigIdent: String;
  764. const ConfigValueDefault, ConfigValueMinimum, ConfigValueNew: Integer; const Msg: String; const Color: TColor;
  765. const HasLink: Boolean); overload;
  766. begin
  767. var ConfigValue := Ini.ReadInteger('UpdatePanel', ConfigIdent, ConfigValueDefault); { Also see HUnregisterClick }
  768. if ConfigValue < ConfigValueMinimum then
  769. FUpdatePanelMessages.Add(TUpdatePanelMessage.Create(Msg, ConfigIdent, ConfigValueNew, Color,
  770. HasLink));
  771. end;
  772. procedure CheckUpdatePanelMessage(const Ini: TConfigIniFile; const ConfigIdent: String;
  773. const ConfigValueDefault, ConfigValueExpected: Integer; const Msg: String; const Color: TColor;
  774. const HasLink: Boolean); overload;
  775. begin
  776. CheckUpdatePanelMessage(Ini, ConfigIdent, ConfigValueDefault, ConfigValueExpected, ConfigValueExpected,
  777. Msg, Color, HasLink);
  778. end;
  779. procedure ReadAndApplyConfig;
  780. var
  781. Ini: TConfigIniFile;
  782. WindowPlacement: TWindowPlacement;
  783. I: Integer;
  784. Memo: TIDEScintEdit;
  785. begin
  786. Ini := TConfigIniFile.Create;
  787. try
  788. { Menu check boxes state }
  789. ToolbarPanel.Visible := Ini.ReadBool('Options', 'ShowToolbar', True);
  790. StatusBar.Visible := Ini.ReadBool('Options', 'ShowStatusBar', True);
  791. FOptions.LowPriorityDuringCompile := Ini.ReadBool('Options', 'LowPriorityDuringCompile', False);
  792. { Configuration options - does not read ThemeType, see ReadAndUpdateTheme instead }
  793. FOptions.ShowStartupForm := Ini.ReadBool('Options', 'ShowStartupForm', True);
  794. FOptions.UseWizard := Ini.ReadBool('Options', 'UseWizard', True);
  795. FOptions.Autosave := Ini.ReadBool('Options', 'Autosave', False);
  796. FOptions.Autoreload := Ini.ReadBool('Options', 'Autoreload', True);
  797. FOptions.MakeBackups := Ini.ReadBool('Options', 'MakeBackups', False);
  798. FOptions.FullPathInTitleBar := Ini.ReadBool('Options', 'FullPathInTitleBar', False);
  799. FOptions.UndoAfterSave := Ini.ReadBool('Options', 'UndoAfterSave', True);
  800. FOptions.UndoAfterReload := Ini.ReadBool('Options', 'UndoAfterReload', True);
  801. FOptions.PauseOnDebuggerExceptions := Ini.ReadBool('Options', 'PauseOnDebuggerExceptions', True);
  802. FOptions.RunAsDifferentUser := Ini.ReadBool('Options', 'RunAsDifferentUser', False);
  803. FOptions.AutoAutoComplete := Ini.ReadBool('Options', 'AutoComplete', True);
  804. FOptions.AutoCallTips := Ini.ReadBool('Options', 'AutoCallTips', True);
  805. FOptions.UseSyntaxHighlighting := Ini.ReadBool('Options', 'UseSynHigh', True);
  806. FOptions.ColorizeCompilerOutput := Ini.ReadBool('Options', 'ColorizeCompilerOutput', True);
  807. FOptions.UnderlineErrors := Ini.ReadBool('Options', 'UnderlineErrors', True);
  808. FOptions.HighlightWordAtCursorOccurrences := Ini.ReadBool('Options', 'HighlightWordAtCursorOccurrences', False);
  809. FOptions.HighlightSelTextOccurrences := Ini.ReadBool('Options', 'HighlightSelTextOccurrences', True);
  810. FOptions.CursorPastEOL := Ini.ReadBool('Options', 'EditorCursorPastEOL', False);
  811. FOptions.TabWidth := Ini.ReadInteger('Options', 'TabWidth', 2);
  812. FOptions.UseTabCharacter := Ini.ReadBool('Options', 'UseTabCharacter', False);
  813. FOptions.ShowWhiteSpace := Ini.ReadBool('Options', 'ShowWhiteSpace', False);
  814. FOptions.SmartHome := Ini.ReadBool('Options', 'SmartHome', True);
  815. FOptions.UseFolding := Ini.ReadBool('Options', 'UseFolding', True);
  816. FOptions.FindRegEx := Ini.ReadBool('Options', 'FindRegEx', False);
  817. FOptions.WordWrap := Ini.ReadBool('Options', 'WordWrap', False);
  818. FOptions.AutoIndent := Ini.ReadBool('Options', 'AutoIndent', True);
  819. FOptions.IndentationGuides := Ini.ReadBool('Options', 'IndentationGuides', True);
  820. FOptions.GutterLineNumbers := Ini.ReadBool('Options', 'GutterLineNumbers', False);
  821. FOptions.ShowPreprocessorOutput := Ini.ReadBool('Options', 'ShowPreprocessorOutput', True);
  822. FOptions.OpenIncludedFiles := Ini.ReadBool('Options', 'OpenIncludedFiles', True);
  823. FOptions.AutoHideNewIncludedFiles := Ini.ReadBool('Options', 'AutoHideNewIncludedFiles', False);
  824. I := Ini.ReadInteger('Options', 'KeyMappingType', Ord(GetDefaultKeyMappingType));
  825. if (I >= 0) and (I <= Ord(High(TKeyMappingType))) then
  826. FOptions.KeyMappingType := TKeyMappingType(I);
  827. I := Ini.ReadInteger('Options', 'MemoKeyMappingType', Ord(GetDefaultMemoKeyMappingType));
  828. if (I >= 0) and (I <= Ord(High(TIDEScintKeyMappingType))) then
  829. FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(I);
  830. FMainMemo.Font.Name := Ini.ReadString('Options', 'EditorFontName', FMainMemo.Font.Name);
  831. FMainMemo.Font.Size := Ini.ReadInteger('Options', 'EditorFontSize', 10);
  832. FMainMemo.Font.Charset := TFontCharSet(Ini.ReadInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset));
  833. FMainMemo.Zoom := Ini.ReadInteger('Options', 'Zoom', 0); { MemoZoom will zoom the other memos }
  834. for Memo in FMemos do
  835. if Memo <> FMainMemo then
  836. Memo.Font := FMainMemo.Font;
  837. { UpdatePanel visibility }
  838. const BannerGreen = $ABE3AB; { MGreen with HSL lightness changed from 40% to 78% }
  839. const BannerBlue = $FFD399; { MBlue with HSL lightness changed from 42% to 80% }
  840. const BannerOrange = $9EB8F0; {MOrange with HSL lightness changed from 63% to 78% }
  841. const BannerRed = $BBB5EE; {MRed with HSL lightness changed from 58% to 82% }
  842. CheckUpdatePanelMessage(Ini, 'KnownVersion', 0, Integer(FCompilerVersion.BinVersion),
  843. 'Your version of Inno Setup has been updated! <a id="hwhatsnew">See what''s new</a>.',
  844. BannerGreen, True);
  845. CheckUpdatePanelMessage(Ini, 'VSCodeMemoKeyMap', 0, 1,
  846. 'VS Code-style editor shortcuts added! Use the <a id="toptions-vscode">Editor Keys option</a> in Options dialog.',
  847. BannerBlue, True);
  848. if FormatDateTime('yyyymm', Date) = '202604' then
  849. CheckUpdatePanelMessage(Ini, 'Ideas202604', 0, 1,
  850. '<a id="ideas">Ideas board is open!</a> Share your ideas and vote on others, this month only.',
  851. BannerBlue, True);
  852. const LicenseState = GetLicenseState;
  853. if LicenseState = lsExpiredButUpdated then begin
  854. { Complain twice per day }
  855. const CurrentHourAsInt = FormatDateTime('yyyymmddhh', Now).ToInteger;
  856. const WarnAgainHourAsInt = FormatDateTime('yyyymmddhh', IncHour(Now, 12)).ToInteger;
  857. const Msg = 'Running a version released after your update entitlement ended. <a id="hpurchase">Renew license</a>, <a id="hunregister">remove key</a>, or <a id="fexit">exit</a>.';
  858. CheckUpdatePanelMessage(Ini, 'Purchase.ExpiredButUpdated', 0, CurrentHourAsInt, WarnAgainHourAsInt, { Also see UpdateUpdatePanel }
  859. Msg, BannerRed, True);
  860. end else if LicenseState in [lsExpiring, lsExpired] then begin
  861. { Warn about expiry, once per week }
  862. const CurrentDateAsInt = FormatDateTime('yyyymmdd', Date).ToInteger;
  863. const WarnAgainDateAsInt = FormatDateTime('yyyymmdd', IncDay(Date, 7)).ToInteger;
  864. const Msg = IfThen(LicenseState = lsExpiring,
  865. 'Your update entitlement is ending soon. Please <a id="hpurchase">renew your license</a>. Thanks!',
  866. 'Your update entitlement has ended. Please <a id="hpurchase">renew your license</a>. Thanks!');
  867. CheckUpdatePanelMessage(Ini, 'Purchase.Renew', 0, CurrentDateAsInt, WarnAgainDateAsInt, { Also see UpdateUpdatePanel }
  868. Msg, BannerOrange, True);
  869. end else if LicenseState = lsNotLicensed then begin
  870. { Ask about current commercial use, once per six months }
  871. const CurrentDateAsInt = FormatDateTime('yyyymmdd', Date).ToInteger;
  872. const AskAgainDateAsInt = FormatDateTime('yyyymmdd', IncDay(IncMonth(Date, 6), -1)).ToInteger; { Also see HUnregisterClick }
  873. CheckUpdatePanelMessage(Ini, 'Purchase', 0, CurrentDateAsInt, AskAgainDateAsInt, { Also see UpdateUpdatePanel and HUnregisterClick }
  874. 'Using Inno Setup commercially? Please <a id="hpurchase">purchase a license</a>. Thanks!',
  875. BannerBlue, True);
  876. end;
  877. UpdateUpdatePanel;
  878. { Debug options }
  879. FOptions.ShowCaretPosition := Ini.ReadBool('Options', 'ShowCaretPosition', False);
  880. if FOptions.ShowCaretPosition then begin
  881. StatusBar.Panels[spCaretPos].Width := 4 * StatusBar.Panels[spCaretPos].Width;
  882. StatusBar.Panels[spCaretPos].Alignment := taLeftJustify;
  883. end;
  884. SyncEditorOptions;
  885. UpdateNewMainFileButtons;
  886. UpdateKeyMapping;
  887. UpdateFindRegExUI;
  888. { Window state }
  889. WindowPlacement.length := SizeOf(WindowPlacement);
  890. GetWindowPlacement(Handle, @WindowPlacement);
  891. WindowPlacement.showCmd := SW_HIDE; { the form isn't Visible yet }
  892. WindowPlacement.rcNormalPosition.Left := Ini.ReadInteger('State',
  893. 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
  894. WindowPlacement.rcNormalPosition.Top := Ini.ReadInteger('State',
  895. 'WindowTop', WindowPlacement.rcNormalPosition.Top);
  896. WindowPlacement.rcNormalPosition.Right := Ini.ReadInteger('State',
  897. 'WindowRight', WindowPlacement.rcNormalPosition.Left + Width);
  898. WindowPlacement.rcNormalPosition.Bottom := Ini.ReadInteger('State',
  899. 'WindowBottom', WindowPlacement.rcNormalPosition.Top + Height);
  900. SetWindowPlacement(Handle, @WindowPlacement);
  901. { Note: Must set WindowState *after* calling SetWindowPlacement, since
  902. TCustomForm.WMSize resets WindowState }
  903. if Ini.ReadBool('State', 'WindowMaximized', False) then
  904. WindowState := wsMaximized;
  905. { Note: Don't call UpdateStatusPanelHeight here since it clips to the
  906. current form height, which hasn't been finalized yet }
  907. { StatusPanel height }
  908. StatusPanel.Height := ToCurrentPPI(Ini.ReadInteger('State', 'StatusPanelHeight',
  909. (10 * FromCurrentPPI(DebugOutputList.ItemHeight) + 4) + FromCurrentPPI(OutputTabSet.Height)));
  910. finally
  911. Ini.Free;
  912. end;
  913. FOptionsLoaded := True;
  914. end;
  915. procedure ReadAndApplyTheme;
  916. begin
  917. const Ini = TConfigIniFile.Create;
  918. try
  919. const I = Ini.ReadInteger('Options', 'ThemeType', Ord(GetDefaultThemeType));
  920. if (I >= 0) and (I <= Ord(High(TThemeType))) then
  921. FOptions.ThemeType := TThemeType(I);
  922. finally
  923. Ini.Free
  924. end;
  925. UpdateTheme;
  926. end;
  927. var
  928. NewItem: TMenuItem;
  929. PopupMenu: TPopupMenu;
  930. Memo: TIDEScintEdit;
  931. begin
  932. inherited;
  933. {$IFNDEF STATICCOMPILER}
  934. FCompilerVersion := ISDllGetVersion;
  935. {$ELSE}
  936. FCompilerVersion := ISGetVersion;
  937. {$ENDIF}
  938. FModifiedAnySinceLastCompile := True;
  939. InitFormFont(Self);
  940. FHighContrastActive := HighContrastActive; { Just checking once at startup }
  941. if FHighContrastActive then begin
  942. { If UseVisualStyle is False (LWS_USEVISUALSTYLE is off) the regular text of the label does not
  943. follow any high contrast theme but stays black instead, which is likely to be invisible.
  944. Setting it to True makes all text (regular and link) to get the COLOR_HOTLIGHT color. }
  945. UpdateLinkLabel.UseVisualStyle := True;
  946. { COLOR_WINDOW is documented as the associated background color of COLOR_HOTLIGHT }
  947. UpdatePanel.Color := clWindow;
  948. end;
  949. { For some reason, if AutoScroll=False is set on the form Delphi ignores the
  950. 'poDefault' Position setting }
  951. AutoScroll := False;
  952. { Append the shortcut key text to the Edit items. Don't actually set the
  953. ShortCut property because we don't want the key combinations having an
  954. effect when Memo doesn't have the focus. }
  955. SetFakeShortCut(EUndo, Ord('Z'), [ssCtrl]);
  956. SetFakeShortCut(ERedo, Ord('Y'), [ssCtrl]);
  957. SetFakeShortCut(ECut, Ord('X'), [ssCtrl]);
  958. SetFakeShortCut(ECopy, Ord('C'), [ssCtrl]);
  959. SetFakeShortCut(EPaste, Ord('V'), [ssCtrl]);
  960. SetFakeShortCut(ESelectAll, Ord('A'), [ssCtrl]);
  961. SetFakeShortCut(EDelete, VK_DELETE, []);
  962. 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 }
  963. SetFakeShortCutText(VZoomOut, SmkcCtrl + 'Num -');
  964. SetFakeShortCutText(VZoomReset, SmkcCtrl + 'Num /');
  965. { Use fake Esc shortcut for Stop Compile so it doesn't conflict with the
  966. editor's autocompletion list }
  967. SetFakeShortCut(BStopCompile, VK_ESCAPE, []);
  968. { Use fake Ctrl+F4 shortcut for VCloseCurrentTab2 because VCloseCurrentTab
  969. already has the real one }
  970. SetFakeShortCut(VCloseCurrentTab2, VK_F4, [ssCtrl]);
  971. { Use fake Ctrl+C and Ctrl+A shortcuts for OutputListPopupMenu's items so they
  972. don't conflict with the editor which also uses fake shortcuts for these }
  973. SetFakeShortCut(POutputListCopy, Ord('C'), [ssCtrl]);
  974. SetFakeShortCut(POutputListSelectAll, Ord('A'), [ssCtrl]);
  975. { Set real shortcut on TOptions which can't be set at design time }
  976. TOptions.ShortCut := ShortCut(VK_OEM_COMMA, [ssCtrl]);
  977. PopupMenu := TMainFormPopupMenu.Create(Self, EMenu);
  978. FMemosStyler := TInnoSetupStyler.Create(Self);
  979. FMemosStyler.ISPPInstalled := ISPPInstalled;
  980. FTheme := TTheme.Create;
  981. InitFormThemeInit(FTheme);
  982. MemosTabSet.Theme := FTheme;
  983. OutputTabSet.Theme := FTheme;
  984. ToolBarPanel.ParentBackground := False;
  985. UpdatePanel.ParentBackground := False;
  986. UpdatePanelDonateBitBtn.Hint := RemoveAccelChar(HDonate.Caption);
  987. UpdateImages;
  988. FMemos := TList<TIDEScintEdit>.Create;
  989. FMainMemo := InitializeMainMemo(TIDEScintFileEdit.Create(Self), PopupMenu);
  990. FMemos.Add(FMainMemo);
  991. FPreprocessorOutputMemo := InitializeNonFileMemo(TIDEScintEdit.Create(Self), PopupMenu);
  992. FMemos.Add(FPreprocessorOutputMemo);
  993. for var I := FMemos.Count to MaxMemos-1 do
  994. FMemos.Add(InitializeFileMemo(TIDEScintFileEdit.Create(Self), PopupMenu));
  995. FFileMemos := TList<TIDEScintFileEdit>.Create;
  996. for Memo in FMemos do
  997. if Memo is TIDEScintFileEdit then
  998. FFileMemos.Add(TIDEScintFileEdit(Memo));
  999. FHiddenFiles := TStringList.Create(dupError, True, False);
  1000. FHiddenFiles.UseLocale := False;
  1001. FActiveMemo := FMainMemo;
  1002. FActiveMemo.Visible := True;
  1003. ActiveControl := FActiveMemo;
  1004. FErrorMemo := FMainMemo;
  1005. FStepMemo := FMainMemo;
  1006. UpdateMarginsAndSquigglyAndCaretWidths;
  1007. FMemosStyler.Theme := FTheme;
  1008. MemosTabSet.PopupMenu := TMainFormPopupMenu.Create(Self, MemosTabSetPopupMenu);
  1009. FFirstTabSelectShortCut := ShortCut(Ord('1'), [ssCtrl]);
  1010. FLastTabSelectShortCut := ShortCut(Ord('9'), [ssCtrl]);
  1011. FNavStacks := TIDEScintEditNavStacks.Create;
  1012. UpdateNavigationButtons;
  1013. FCurrentNavItem.Invalidate;
  1014. BackNavButton.Style := tbsDropDown;
  1015. BackNavButton.DropdownMenu := TMainFormPopupMenu.Create(Self, NavPopupMenu);
  1016. PopupMenu := TMainFormPopupMenu.Create(Self, OutputListPopupMenu);
  1017. CompilerOutputList.PopupMenu := PopupMenu;
  1018. DebugOutputList.PopupMenu := PopupMenu;
  1019. DebugCallStackList.PopupMenu := PopupMenu;
  1020. FindResultsList.PopupMenu := PopupMenu;
  1021. UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  1022. Application.HintShortPause := 0;
  1023. Application.OnException := AppOnException;
  1024. Application.OnActivate := AppOnActivate;
  1025. Application.OnIdle := AppOnIdle;
  1026. FMRUMainFilesList := TStringList.Create;
  1027. for var I := 0 to High(FMRUMainFilesMenuItems) do begin
  1028. NewItem := TMenuItem.Create(Self);
  1029. NewItem.OnClick := FMRUClick;
  1030. FRecent.Insert(I, NewItem);
  1031. FMRUMainFilesMenuItems[I] := NewItem;
  1032. end;
  1033. FMRUParametersList := TStringList.Create;
  1034. FSignTools := TStringList.Create;
  1035. FFindResults := TFindResults.Create;
  1036. FIncludedFiles := TIncludedFiles.Create;
  1037. UpdatePreprocMemos;
  1038. FDebugTarget := dtSetup;
  1039. UpdateTargetMenu;
  1040. ReadLicense;
  1041. UpdateCaption;
  1042. FMenuDarkBackgroundBrush := TBrush.Create;
  1043. FMenuDarkHotOrSelectedBrush := TBrush.Create;
  1044. LightToolbarVirtualImageList.AutoFill := True;
  1045. ThemedMarkersAndACVirtualImageList.AutoFill := True;
  1046. UpdateThemeData(True);
  1047. FMenuBitmaps := TMenuBitmaps.Create;
  1048. FMenuBitmapsSize.cx := 0;
  1049. FMenuBitmapsSize.cy := 0;
  1050. FKeyMappedMenus := TKeyMappedMenus.Create;
  1051. FCallTipState.MaxCallTips := 1; { Just like SciTE 5.50 }
  1052. FUpdatePanelMessages := TUpdatePanelMessages.Create;
  1053. if CommandLineCompile then begin
  1054. ReadAndApplyTheme;
  1055. ReadSignTools(FSignTools);
  1056. PostMessage(Handle, WM_StartCommandLineCompile, 0, 0)
  1057. end else if CommandLineWizard then begin
  1058. { Stop Delphi from showing the compiler form }
  1059. Application.ShowMainForm := False;
  1060. { Show wizard form later }
  1061. ReadAndApplyTheme;
  1062. PostMessage(Handle, WM_StartCommandLineWizard, 0, 0);
  1063. end else begin
  1064. ReadAndApplyConfig;
  1065. ReadAndApplyTheme;
  1066. ReadSignTools(FSignTools);
  1067. PostMessage(Handle, WM_StartNormally, 0, 0);
  1068. end;
  1069. end;
  1070. destructor TMainForm.Destroy;
  1071. procedure SaveConfig;
  1072. var
  1073. Ini: TConfigIniFile;
  1074. WindowPlacement: TWindowPlacement;
  1075. begin
  1076. Ini := TConfigIniFile.Create;
  1077. try
  1078. { Theme state - can change without opening the options }
  1079. Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see TOptionsClick }
  1080. { Menu check boxes state }
  1081. Ini.WriteBool('Options', 'ShowToolbar', ToolbarPanel.Visible);
  1082. Ini.WriteBool('Options', 'ShowStatusBar', StatusBar.Visible);
  1083. Ini.WriteBool('Options', 'LowPriorityDuringCompile', FOptions.LowPriorityDuringCompile);
  1084. { Window state }
  1085. WindowPlacement.length := SizeOf(WindowPlacement);
  1086. GetWindowPlacement(Handle, @WindowPlacement);
  1087. Ini.WriteInteger('State', 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
  1088. Ini.WriteInteger('State', 'WindowTop', WindowPlacement.rcNormalPosition.Top);
  1089. Ini.WriteInteger('State', 'WindowRight', WindowPlacement.rcNormalPosition.Right);
  1090. Ini.WriteInteger('State', 'WindowBottom', WindowPlacement.rcNormalPosition.Bottom);
  1091. { The GetWindowPlacement docs claim that "flags" is always zero.
  1092. Fortunately, that's wrong. WPF_RESTORETOMAXIMIZED is set when the
  1093. window is either currently maximized, or currently minimized from a
  1094. previous maximized state. }
  1095. Ini.WriteBool('State', 'WindowMaximized', WindowPlacement.flags and WPF_RESTORETOMAXIMIZED <> 0);
  1096. Ini.WriteInteger('State', 'StatusPanelHeight', FromCurrentPPI(StatusPanel.Height));
  1097. { Zoom state }
  1098. Ini.WriteInteger('Options', 'Zoom', FMainMemo.Zoom); { Only saves the main memo's zoom }
  1099. finally
  1100. Ini.Free;
  1101. end;
  1102. end;
  1103. begin
  1104. UpdateThemeData(False);
  1105. Application.OnActivate := nil;
  1106. Application.OnIdle := nil;
  1107. if FOptionsLoaded and not (CommandLineCompile or CommandLineWizard) then
  1108. SaveConfig;
  1109. if FDevMode <> 0 then
  1110. GlobalFree(FDevMode);
  1111. if FDevNames <> 0 then
  1112. GlobalFree(FDevNames);
  1113. FUpdatePanelMessages.Free;
  1114. FNavStacks.Free;
  1115. FKeyMappedMenus.Free;
  1116. FMenuBitmaps.Free;
  1117. FMenuDarkBackgroundBrush.Free;
  1118. FMenuDarkHotOrSelectedBrush.Free;
  1119. FTheme.Free;
  1120. DestroyDebugInfo;
  1121. FIncludedFiles.Free;
  1122. FFindResults.Free;
  1123. FSignTools.Free;
  1124. FMRUParametersList.Free;
  1125. FMRUMainFilesList.Free;
  1126. FFileMemos.Free;
  1127. FHiddenFiles.Free;
  1128. FMemos.Free;
  1129. inherited;
  1130. end;
  1131. function TMainForm.GetBorderStyle: TFormBorderStyle;
  1132. begin
  1133. Result := inherited BorderStyle;
  1134. end;
  1135. procedure TMainForm.SetBorderStyle(Value: TFormBorderStyle);
  1136. begin
  1137. { Hack: To stop the Delphi IDE from adding Explicit* properties to the .dfm
  1138. file every time the unit is saved, we set BorderStyle=bsNone on the form.
  1139. At run-time, ignore that setting so that BorderStyle stays at the default
  1140. value, bsSizeable.
  1141. It would be simpler to change BorderStyle from bsNone to bsSizeable in the
  1142. form's constructor, but it doesn't quite work: when a form's handle is
  1143. created while BorderStyle=bsNone, Position=poDefault behaves like
  1144. poDefaultPosOnly (see TCustomForm.CreateParams). }
  1145. if Value <> bsNone then
  1146. inherited BorderStyle := Value;
  1147. end;
  1148. class procedure TMainForm.AppOnGetActiveFormHandle(var AHandle: HWND);
  1149. begin
  1150. { As of Delphi 11.3, the default code in TApplication.GetActiveFormHandle
  1151. (which runs after this handler) calls GetActiveWindow, and if that returns
  1152. 0, it calls GetLastActivePopup(Application.Handle).
  1153. The problem is that when the application isn't in the foreground,
  1154. GetActiveWindow returns 0, and when MainFormOnTaskBar=True, the
  1155. GetLastActivePopup call normally just returns Application.Handle (since
  1156. there are no popups owned by the application window).
  1157. So if the application calls Application.MessageBox while it isn't in the
  1158. foreground, that message box will be owned by Application.Handle, not by
  1159. the last-active window as it should be. That can lead to the message box
  1160. falling behind the main form in z-order.
  1161. To rectify that, when no window is active and MainFormOnTaskBar=True, we
  1162. fall back to returning the handle of the main form's last active popup,
  1163. which is the window that would be activated if the main form's taskbar
  1164. button were clicked. (If Application.Handle is active, we treat that the
  1165. same as no active window because Application.Handle shouldn't be the owner
  1166. of any windows when MainFormOnTaskBar=True.)
  1167. If there is no assigned main form or if MainFormOnTaskBar=False, then we
  1168. fall back to the default handling. }
  1169. if Application.MainFormOnTaskBar then begin
  1170. AHandle := GetActiveWindow;
  1171. if ((AHandle = 0) or (AHandle = Application.Handle)) and
  1172. Assigned(Application.MainForm) and
  1173. Application.MainForm.HandleAllocated then
  1174. AHandle := GetLastActivePopup(Application.MainFormHandle);
  1175. end;
  1176. end;
  1177. procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  1178. NewDPI: Integer);
  1179. begin
  1180. UpdateImages;
  1181. UpdateMarginsAndAutoCompleteIcons;
  1182. UpdateMarginsAndSquigglyAndCaretWidths;
  1183. UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  1184. UpdateStatusPanelHeight(StatusPanel.Height);
  1185. end;
  1186. procedure TMainForm.FormCloseQuery(Sender: TObject;
  1187. var CanClose: Boolean);
  1188. begin
  1189. if IsWindowEnabled(Handle) then
  1190. CanClose := ConfirmCloseFile(True)
  1191. else
  1192. { CloseQuery is also called by the VCL when a WM_QUERYENDSESSION message
  1193. is received. Don't display message box if a modal dialog is already
  1194. displayed. }
  1195. CanClose := False;
  1196. end;
  1197. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  1198. Shift: TShiftState);
  1199. procedure AddControlToArray(const ControlToAdd: TWinControl; var Controls: TArray<TWinControl>;
  1200. var NControls: NativeInt);
  1201. begin
  1202. Inc(NControls);
  1203. SetLength(Controls, NControls);
  1204. Controls[NControls-1] := ControlToAdd;
  1205. end;
  1206. begin
  1207. var AShortCut := ShortCut(Key, Shift);
  1208. if (AShortCut = VK_ESCAPE) and BStopCompile.Enabled then begin
  1209. Key := 0; { Intentionally only done when BStopCompile is enabled to allow the memo to process it instead }
  1210. BStopCompileClick(Self)
  1211. end else if (AShortCut = FBackNavButtonShortCut) or
  1212. ((FBackNavButtonShortCut2 <> 0) and (AShortCut = FBackNavButtonShortCut2)) then begin
  1213. Key := 0;
  1214. if BackNavButton.Enabled then
  1215. BackNavButtonClick(Self);
  1216. end else if (AShortCut = FForwardNavButtonShortCut) or
  1217. ((FForwardNavButtonShortCut2 <> 0) and (AShortCut = FForwardNavButtonShortCut2)) then begin
  1218. Key := 0;
  1219. if ForwardNavButton.Enabled then
  1220. ForwardNavButtonClick(Self);
  1221. end else if (AShortCut >= FFirstTabSelectShortCut) and (AShortCut <= FLastTabSelectShortCut) then begin
  1222. Key := 0;
  1223. if MemosTabSet.Visible then begin
  1224. var TabIndex := AShortCut - FFirstTabSelectShortCut;
  1225. if TabIndex < 8 then begin
  1226. if TabIndex < MemosTabSet.Tabs.Count then
  1227. MemosTabSet.TabIndex := TabIndex;
  1228. end else { Ctrl+9 = Select last tab }
  1229. MemosTabSet.TabIndex := MemosTabSet.Tabs.Count-1;
  1230. end;
  1231. end else if AShortCut = FCompileShortCut2 then begin
  1232. Key := 0;
  1233. if BCompile.Enabled then
  1234. BCompileClick(Self);
  1235. end else if (Key = Ord('W')) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssCtrl]) then begin
  1236. Key := 0;
  1237. UpdateViewMenu(VMenu); { VCloseCurrentTab.Enabled is not kept updated }
  1238. if VCloseCurrentTab.Enabled then
  1239. VCloseCurrentTabClick(Self);
  1240. end else if (Key = VK_F6) and not (ssAlt in Shift) then begin
  1241. { Move focus between the active memo, the active bottom pane, and the active banner }
  1242. Key := 0;
  1243. { First get the list of controls to toggle between }
  1244. var Controls: TArray<TWinControl> := [FActiveMemo];
  1245. var NControls: NativeInt := Length(Controls); { Explicit type for Delphi 10.4 }
  1246. if StatusPanel.Visible then begin
  1247. var ControlToAdd: TWinControl := nil;
  1248. case OutputTabSet.TabIndex of
  1249. tiCompilerOutput: ControlToAdd := CompilerOutputList;
  1250. tiDebugOutput: ControlToAdd := DebugOutputList;
  1251. tiDebugCallStack: ControlToAdd := DebugCallStackList;
  1252. tiFindResults: ControlToAdd := FindResultsList;
  1253. end;
  1254. if ControlToAdd <> nil then
  1255. AddControlToArray(ControlToAdd, Controls, NControls);
  1256. end;
  1257. if UpdatePanel.Visible then begin
  1258. if FUpdatePanelMessages[UpdateLinkLabel.Tag].HasLink then
  1259. AddControlToArray(UpdateLinkLabel, Controls, NControls);
  1260. AddControlToArray(UpdatePanelDonateBitBtn, Controls, NControls);
  1261. AddControlToArray(UpdatePanelCloseBitBtn, Controls, NControls);
  1262. end;
  1263. { Now move focus to next }
  1264. if NControls > 1 then begin
  1265. for var I := 0 to NControls-1 do begin
  1266. if ActiveControl = Controls[I] then begin
  1267. if I = NControls-1 then
  1268. ActiveControl := Controls[0]
  1269. else
  1270. ActiveControl := Controls[I+1];
  1271. Exit;
  1272. end;
  1273. end;
  1274. end;
  1275. { Didn't move }
  1276. if ActiveControl <> FActiveMemo then
  1277. ActiveControl := FActiveMemo;
  1278. end;
  1279. end;
  1280. procedure TMainForm.MemoKeyDown(Sender: TObject; var Key: Word;
  1281. Shift: TShiftState);
  1282. begin
  1283. if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then begin
  1284. var Memo := Sender as TIDEScintEdit;
  1285. { Make sure we don't break the special rectangular select shortcuts }
  1286. if Shift * [ssShift, ssAlt, ssCtrl] <> Memo.GetRectExtendShiftState then begin
  1287. if Memo.SelectionMode in [ssmRectangular, ssmThinRectangular] then begin
  1288. { Allow left/right/etc. navigation with rectangular selection, see
  1289. https://sourceforge.net/p/scintilla/feature-requests/1275/ and
  1290. https://sourceforge.net/p/scintilla/bugs/2412/#cb37
  1291. Notepad++ calls this "Enable Column Selection to Multi-editing" which
  1292. is on by default and in VSCode and VS it's also on by default. }
  1293. Memo.SelectionMode := ssmStream;
  1294. end;
  1295. end;
  1296. { Key is not cleared to allow Scintilla to do the actual handling }
  1297. end;
  1298. if Key = VK_F1 then begin
  1299. Key := 0;
  1300. var HelpFile := GetHelpFile;
  1301. if Assigned(HtmlHelp) then begin
  1302. HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_DISPLAY_TOPIC, 0);
  1303. var S := FActiveMemo.WordAtCaret;
  1304. if S <> '' then begin
  1305. var KLink: THH_AKLINK;
  1306. FillChar(KLink, SizeOf(KLink), 0);
  1307. KLink.cbStruct := SizeOf(KLink);
  1308. KLink.pszKeywords := PChar(S);
  1309. KLink.fIndexOnFail := True;
  1310. HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_KEYWORD_LOOKUP, DWORD_PTR(@KLink));
  1311. end;
  1312. end;
  1313. end else if ((Key = Ord('V')) or (Key = VK_INSERT)) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssCtrl]) then begin
  1314. if FActiveMemo.CanPaste then
  1315. if MultipleSelectionPasteFromClipboard(FActiveMemo) then
  1316. Key := 0;
  1317. end else if (Key = VK_SPACE) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssShift, ssCtrl]) then begin
  1318. Key := 0;
  1319. CallTipsHandleCtrlSpace(FActiveMemo);
  1320. end else begin
  1321. var AShortCut := ShortCut(Key, Shift);
  1322. { Check if the memo keymap wants us to handle the shortcut but first check
  1323. the menu keymap didn't already claim the same shortcut. Other shortcuts
  1324. (which are always same and not set by the menu keymap) are assumed to
  1325. never conflict. }
  1326. if not FKeyMappedMenus.ContainsKey(AShortCut) then begin
  1327. var ComplexCommand := FActiveMemo.GetComplexCommand(AShortCut);
  1328. if ComplexCommand <> ccNone then begin
  1329. if Key <> VK_ESCAPE then { Allow Scintilla to see Esc }
  1330. Key := 0;
  1331. case ComplexCommand of
  1332. ccSelectNextOccurrence:
  1333. ESelectNextOccurrenceClick(Self);
  1334. ccSelectAllOccurrences:
  1335. ESelectAllOccurrencesClick(Self);
  1336. ccSelectAllFindMatches:
  1337. ESelectAllFindMatchesClick(Self);
  1338. ccFoldLine:
  1339. EFoldOrUnfoldLineClick(EFoldLine);
  1340. ccUnfoldLine:
  1341. EFoldOrUnfoldLineClick(EUnfoldLine);
  1342. ccSimplifySelection:
  1343. SimplifySelection(FActiveMemo);
  1344. ccToggleLinesComment:
  1345. EToggleLinesCommentClick(Self); //GetComplexCommand already checked ReadOnly for us
  1346. ccAddCursorUp, ccAddCursorDown:
  1347. AddCursorUpOrDown(FActiveMemo, ComplexCommand = ccAddCursorUp);
  1348. ccBraceMatch:
  1349. EBraceMatchClick(Self);
  1350. ccAddCursorsToLineEnds:
  1351. AddCursorsToLineEnds(FActiveMemo);
  1352. else
  1353. raise Exception.Create('Unknown ComplexCommand');
  1354. end;
  1355. end;
  1356. end;
  1357. end;
  1358. end;
  1359. procedure TMainForm.MemoKeyPress(Sender: TObject; var Key: Char);
  1360. begin
  1361. if ((Key = #9) or (Key = ' ')) and (GetKeyState(VK_CONTROL) < 0) then begin
  1362. { About #9, as Wikipedia explains: "The most known and common tab is a
  1363. horizontal tabulation <..> and may be referred to as Ctrl+I." Ctrl+I is
  1364. (just like in Visual Studio Code) our alternative code completion character
  1365. because Ctrl+Space is used by the Chinese IME and Alt+Right is used for the
  1366. forward button. So that's why we handle #9 here. Doesn't mean Ctrl+Tab
  1367. doesn't work: it doesnt trigger KeyPress, even if it wasn't a menu
  1368. shortcut for Next Tab (which it is). }
  1369. InitiateAutoComplete(FActiveMemo, #0);
  1370. Key := #0;
  1371. end else if (Key <= #31) or (Key = #127) then begin
  1372. { Prevent "control characters" from being entered in text. Don't need to be
  1373. concerned about #9 or #10 or #13 etc here. Based on Notepad++'s WM_CHAR
  1374. handling in ScintillaEditView.cpp.
  1375. Also don't need to be concerned about shortcuts like Ctrl+Shift+- which
  1376. equals #31. }
  1377. Key := #0
  1378. end;
  1379. end;
  1380. procedure TMainForm.FormResize(Sender: TObject);
  1381. begin
  1382. { Make sure the status panel's height is decreased if necessary in response
  1383. to the form's height decreasing }
  1384. if StatusPanel.Visible then
  1385. UpdateStatusPanelHeight(StatusPanel.Height);
  1386. end;
  1387. procedure TMainForm.WndProc(var Message: TMessage);
  1388. begin
  1389. { Without this, the status bar's owner drawn panels sometimes get corrupted and show
  1390. menu items instead. See:
  1391. http://groups.google.com/group/borland.public.delphi.vcl.components.using/browse_thread/thread/e4cb6c3444c70714 }
  1392. with Message do
  1393. case Msg of
  1394. WM_DRAWITEM:
  1395. with PDrawItemStruct(Message.LParam)^ do
  1396. if (CtlType = ODT_MENU) and not IsMenu(hwndItem) then
  1397. CtlType := ODT_STATIC;
  1398. end;
  1399. inherited
  1400. end;
  1401. function TMainForm.IsShortCut(var Message: TWMKey): Boolean;
  1402. begin
  1403. { Key messages are forwarded by the VCL to the main form for ShortCut
  1404. processing. In Delphi 5+, however, this happens even when a TFindDialog
  1405. is active, causing Ctrl+V/Esc/etc. to be intercepted by the main form.
  1406. Work around this by always returning False when not Active. }
  1407. if Active then
  1408. Result := inherited IsShortCut(Message)
  1409. else
  1410. Result := False;
  1411. end;
  1412. procedure TMainForm.UpdateCaption;
  1413. var
  1414. NewCaption: String;
  1415. begin
  1416. if FMainMemo.Filename = '' then
  1417. NewCaption := GetFileTitle(FMainMemo.Filename)
  1418. else begin
  1419. if FOptions.FullPathInTitleBar then
  1420. NewCaption := FMainMemo.Filename
  1421. else
  1422. NewCaption := GetDisplayFilename(FMainMemo.Filename);
  1423. end;
  1424. NewCaption := NewCaption + ' '#$2013' ' + SCompilerFormCaption + ' ' +
  1425. String(FCompilerVersion.Version) {$IFNDEF WIN64} + ' (32-bit)' {$ENDIF} +
  1426. ' '#$2013' ' + GetLicenseeDescription;
  1427. if FCompiling then
  1428. NewCaption := NewCaption + ' [Compiling]'
  1429. else if FDebugging then begin
  1430. if not FPaused then
  1431. NewCaption := NewCaption + ' [Running]'
  1432. else
  1433. NewCaption := NewCaption + ' [Paused]';
  1434. end;
  1435. Caption := NewCaption;
  1436. if not CommandLineWizard then
  1437. Application.Title := NewCaption;
  1438. end;
  1439. procedure TMainForm.NewMainFile(const IsReload: Boolean);
  1440. var
  1441. Memo: TIDEScintFileEdit;
  1442. begin
  1443. HideError;
  1444. FUninstExe := '';
  1445. if FDebugTarget <> dtSetup then begin
  1446. FDebugTarget := dtSetup;
  1447. UpdateTargetMenu;
  1448. end;
  1449. FHiddenFiles.Clear;
  1450. InvalidateStatusPanel(spHiddenFilesCount);
  1451. for Memo in FFileMemos do
  1452. if Memo.Used then
  1453. Memo.BreakPoints.Clear;
  1454. DestroyDebugInfo;
  1455. FMainMemo.Filename := '';
  1456. UpdateCaption;
  1457. FMainMemo.SaveEncoding := seUTF8WithoutBOM;
  1458. if not IsReload then
  1459. FMainMemo.Lines.Clear;
  1460. FModifiedAnySinceLastCompile := True;
  1461. FPreprocessorOutput := '';
  1462. FIncludedFiles.Clear;
  1463. UpdatePreprocMemos(IsReload);
  1464. if not IsReload then
  1465. FMainMemo.ClearUndo;
  1466. FNavStacks.Clear;
  1467. UpdateNavigationButtons;
  1468. FCurrentNavItem.Invalidate;
  1469. end;
  1470. { Breakpoints are preserved on a per-file basis }
  1471. procedure TMainForm.LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
  1472. begin
  1473. if AMemo.BreakPoints.Count <> 0 then
  1474. raise Exception.Create('AMemo.BreakPoints.Count <> 0'); { NewMainFile or OpenFile should have cleared these }
  1475. try
  1476. var HadSkippedBreakPoint := False;
  1477. var Strings := TStringList.Create;
  1478. try
  1479. LoadBreakPointLines(AMemo.FileName, Strings);
  1480. for var LineAsString in Strings do begin
  1481. var Line := LineAsString.ToInteger;
  1482. if Line < AMemo.Lines.Count then
  1483. AMemo.BreakPoints.Add(Line)
  1484. else
  1485. HadSkippedBreakPoint := True;
  1486. end;
  1487. finally
  1488. Strings.Free;
  1489. end;
  1490. for var Line in AMemo.BreakPoints do
  1491. UpdateLineMarkers(AMemo, Line);
  1492. { If there were breakpoints beyond the end of file get rid of them so they
  1493. don't magically reappear on a reload of an externally edited and grown
  1494. file }
  1495. if HadSkippedBreakPoint then
  1496. BuildAndSaveBreakPointLines(AMemo);
  1497. except
  1498. { Ignore any exceptions }
  1499. end;
  1500. end;
  1501. procedure TMainForm.BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
  1502. begin
  1503. try
  1504. if AMemo.FileName <> '' then begin
  1505. var Strings := TStringList.Create;
  1506. try
  1507. for var Line in AMemo.BreakPoints do
  1508. Strings.Add(Line.ToString);
  1509. SaveBreakPointLines(AMemo.FileName, Strings);
  1510. finally
  1511. Strings.Free;
  1512. end;
  1513. end;
  1514. except
  1515. { Handle exceptions locally; failure to save the breakpoint lines list should not be
  1516. a fatal error }
  1517. Application.HandleException(Self);
  1518. end;
  1519. end;
  1520. { Known included and hidden files are preserved on a per-main-file basis }
  1521. procedure TMainForm.LoadKnownIncludedAndHiddenFilesAndUpdateMemos;
  1522. begin
  1523. if FIncludedFiles.Count <> 0 then
  1524. raise Exception.Create('FIncludedFiles.Count <> 0'); { NewMainFile should have cleared these }
  1525. try
  1526. if AFilename <> '' then begin
  1527. var Strings := TStringList.Create;
  1528. try
  1529. LoadKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
  1530. if Strings.Count > 0 then begin
  1531. try
  1532. for var Filename in Strings do begin
  1533. var IncludedFile := TIncludedFile.Create;
  1534. IncludedFile.Filename := Filename;
  1535. IncludedFile.CompilerFileIndex := UnknownCompilerFileIndex;
  1536. IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
  1537. @IncludedFile.LastWriteTime);
  1538. FIncludedFiles.Add(IncludedFile);
  1539. end;
  1540. finally
  1541. UpdatePreprocMemos;
  1542. end;
  1543. end;
  1544. finally
  1545. Strings.Free;
  1546. end;
  1547. end;
  1548. except
  1549. { Ignore any exceptions }
  1550. end;
  1551. end;
  1552. procedure TMainForm.BuildAndSaveKnownIncludedAndHiddenFiles;
  1553. begin
  1554. try
  1555. if FMainMemo.FileName <> '' then begin
  1556. var Strings := TStringList.Create;
  1557. try
  1558. for var IncludedFile in FIncludedFiles do
  1559. Strings.Add(IncludedFile.Filename);
  1560. SaveKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
  1561. finally
  1562. Strings.Free;
  1563. end;
  1564. end;
  1565. except
  1566. { Handle exceptions locally; failure to save the includes list should not be
  1567. a fatal error }
  1568. Application.HandleException(Self);
  1569. end;
  1570. end;
  1571. procedure TMainForm.NewMainFileUsingWizard;
  1572. var
  1573. WizardForm: TWizardForm;
  1574. SaveEnabled: Boolean;
  1575. begin
  1576. WizardForm := TWizardForm.Create(Application);
  1577. try
  1578. SaveEnabled := Enabled;
  1579. if CommandLineWizard then begin
  1580. WizardForm.WizardName := CommandLineWizardName;
  1581. { Must disable MainForm even though it isn't shown, otherwise
  1582. menu keyboard shortcuts (such as Ctrl+O) still work }
  1583. Enabled := False;
  1584. end;
  1585. try
  1586. if WizardForm.ShowModal <> mrOk then
  1587. Exit;
  1588. finally
  1589. Enabled := SaveEnabled;
  1590. end;
  1591. if CommandLineWizard then begin
  1592. SaveTextToFile(CommandLineFileName, WizardForm.ResultScript, seUTF8WithoutBOM);
  1593. end else begin
  1594. NewMainFile;
  1595. FMainMemo.Lines.Text := WizardForm.ResultScript;
  1596. FMainMemo.ClearUndo;
  1597. if WizardForm.Result = wrComplete then begin
  1598. FMainMemo.ForceModifiedState;
  1599. if MsgBox('Would you like to compile the new script now?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  1600. BCompileClick(Self);
  1601. end;
  1602. end;
  1603. finally
  1604. WizardForm.Free;
  1605. end;
  1606. end;
  1607. procedure TMainForm.OpenFile(AMemo: TIDEScintFileEdit; AFilename: String;
  1608. const MainMemoAddToRecentDocs, IsReload: Boolean);
  1609. function GetStreamSaveEncoding(const Stream: TStream): TSaveEncoding;
  1610. var
  1611. Buf: array[0..2] of Byte;
  1612. begin
  1613. Result := seAuto;
  1614. var StreamSize := Stream.Size;
  1615. var CappedSize: Integer;
  1616. if StreamSize > High(Integer) then
  1617. CappedSize := High(Integer)
  1618. else
  1619. CappedSize := Integer(StreamSize);
  1620. if (CappedSize >= SizeOf(Buf)) and (Stream.Read(Buf, SizeOf(Buf)) = SizeOf(Buf)) and
  1621. (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then
  1622. Result := seUTF8WithBOM
  1623. else begin
  1624. Stream.Seek(0, soFromBeginning);
  1625. var S: AnsiString;
  1626. SetLength(S, CappedSize);
  1627. SetLength(S, Stream.Read(S[1], CappedSize));
  1628. if DetectUTF8Encoding(S) in [etUSASCII, etUTF8] then
  1629. Result := seUTF8WithoutBOM;
  1630. end;
  1631. end;
  1632. function GetEncoding(const SaveEncoding: TSaveEncoding): TEncoding;
  1633. begin
  1634. if SaveEncoding in [seUTF8WithBOM, seUTF8WithoutBOM] then
  1635. Result := TEncoding.UTF8
  1636. else
  1637. Result := nil;
  1638. end;
  1639. { Same as TStrings.LoadFromStream, except that it returns the loaded string and that
  1640. it caps the size same as GetStreamSaveEncoding }
  1641. function LoadFromStream(const Stream: TStream; const Encoding: TEncoding): String;
  1642. begin
  1643. const SizeLeft = Stream.Size - Stream.Position;
  1644. var CappedSize: Integer;
  1645. if SizeLeft > High(Integer) then
  1646. CappedSize := High(Integer)
  1647. else
  1648. CappedSize := Integer(SizeLeft);
  1649. var Buffer: TBytes;
  1650. SetLength(Buffer, CappedSize);
  1651. Stream.Read(Buffer, 0, CappedSize);
  1652. var BufferEncoding := Encoding;
  1653. const PreambleSize = TEncoding.GetBufferEncoding(Buffer, BufferEncoding, TEncoding.Default);
  1654. Result := BufferEncoding.GetString(Buffer, PreambleSize, CappedSize - PreambleSize);
  1655. end;
  1656. type
  1657. TFilePosition = record
  1658. Selection: TScintCaretAndAnchor;
  1659. ScrollPosition: Integer;
  1660. end;
  1661. { See SciTEBase::CheckReload }
  1662. function GetFilePosition(const AMemo: TScintEdit): TFilePosition;
  1663. begin
  1664. Result.Selection.CaretPos := AMemo.CaretPosition;
  1665. Result.Selection.AnchorPos := AMemo.AnchorPosition;
  1666. Result.ScrollPosition := AMemo.GetDocLineFromVisibleLine(AMemo.TopLine);
  1667. end;
  1668. { See SciTEBase::CheckReload }
  1669. procedure DisplayAround(const AMemo: TScintEdit; const FilePosition: TFilePosition);
  1670. begin
  1671. AMemo.Call(SCI_SETSEL, FilePosition.Selection.AnchorPos, FilePosition.Selection.CaretPos);
  1672. const CurTop = AMemo.TopLine;
  1673. const LineTop = AMemo.GetVisibleLineFromDocLine(FilePosition.ScrollPosition);
  1674. AMemo.Call(SCI_LINESCROLL, 0, LineTop - CurTop);
  1675. AMemo.ChooseCaretX;
  1676. end;
  1677. var
  1678. Stream: TFileStream;
  1679. begin
  1680. AMemo.OpeningFile := True;
  1681. try
  1682. AFilename := PathExpand(AFilename);
  1683. const NameChange = PathCompare(AMemo.Filename, AFilename) <> 0;
  1684. const FilePosition = GetFilePosition(AMemo);
  1685. if IsReload then
  1686. AMemo.BeginUndoAction;
  1687. Stream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
  1688. try
  1689. if AMemo = FMainMemo then
  1690. NewMainFile(IsReload)
  1691. else begin
  1692. AMemo.BreakPoints.Clear;
  1693. if DestroyLineState(AMemo) then
  1694. UpdateAllMemoLineMarkers(AMemo);
  1695. if NameChange then { Also see below the other case which needs to be done after load }
  1696. RemoveMemoFromNavigation(AMemo);
  1697. end;
  1698. GetFileTime(Stream.Handle, nil, nil, @AMemo.FileLastWriteTime);
  1699. AMemo.SaveEncoding := GetStreamSaveEncoding(Stream);
  1700. Stream.Seek(0, soFromBeginning);
  1701. const TextStr = LoadFromStream(Stream, GetEncoding(AMemo.SaveEncoding));
  1702. if IsReload and (AMemo.ChangeHistory <> schDisabled) then begin
  1703. { Workaround to minimize change history on reload }
  1704. AMemo.Call(SCI_TARGETWHOLEDOCUMENT, 0, 0);
  1705. const RawTextStr = AMemo.ConvertStringToRawString(TextStr);
  1706. AMemo.Call(SCI_REPLACETARGETMINIMAL, Length(RawTextStr), RawTextStr);
  1707. end else
  1708. AMemo.Lines.Text := TextStr;
  1709. if (AMemo <> FMainMemo) and not NameChange then
  1710. RemoveMemoBadLinesFromNavigation(AMemo);
  1711. finally
  1712. Stream.Free;
  1713. if IsReload then
  1714. AMemo.EndUndoAction;
  1715. end;
  1716. if IsReload then begin
  1717. DisplayAround(AMemo, FilePosition);
  1718. AMemo.SetSavePoint;
  1719. end else
  1720. AMemo.ClearUndo;
  1721. if AMemo = FMainMemo then begin
  1722. AMemo.Filename := AFilename;
  1723. UpdateCaption;
  1724. ModifyMRUMainFilesList(AFilename, True);
  1725. if MainMemoAddToRecentDocs then
  1726. AddFileToRecentDocs(AFilename);
  1727. LoadKnownIncludedAndHiddenFilesAndUpdateMemos(AFilename);
  1728. InvalidateStatusPanel(spHiddenFilesCount);
  1729. end;
  1730. LoadBreakPointLinesAndUpdateLineMarkers(AMemo);
  1731. finally
  1732. AMemo.OpeningFile := False;
  1733. end;
  1734. end;
  1735. procedure TMainForm.OpenMRUMainFile(const AFilename: String);
  1736. { Same as OpenFile, but offers to remove the file from the MRU list if it
  1737. cannot be opened }
  1738. begin
  1739. try
  1740. OpenFile(FMainMemo, AFilename, True);
  1741. except
  1742. Application.HandleException(Self);
  1743. if MsgBoxFmt('There was an error opening the file. Remove it from the list?',
  1744. [AFilename], SCompilerFormCaption, mbError, MB_YESNO) = IDYES then begin
  1745. ModifyMRUMainFilesList(AFilename, False);
  1746. DeleteBreakPointLines(AFilename);
  1747. DeleteKnownIncludedAndHiddenFiles(AFilename);
  1748. end;
  1749. end;
  1750. end;
  1751. function TMainForm.SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
  1752. procedure SaveMemoTo(const FN: String);
  1753. var
  1754. TempFN, BackupFN: String;
  1755. Buf: array[0..4095] of Char;
  1756. begin
  1757. { Save to a temporary file; don't overwrite existing files in place. This
  1758. way, if the system crashes or the disk runs out of space during the save,
  1759. the existing file will still be intact. }
  1760. if GetTempFileName(PChar(PathExtractDir(FN)), 'iss', 0, Buf) = 0 then
  1761. raise Exception.CreateFmt('Error creating file (code %d). Could not save file',
  1762. [GetLastError]);
  1763. TempFN := Buf;
  1764. try
  1765. SaveTextToFile(TempFN, AMemo.Lines.Text, AMemo.SaveEncoding);
  1766. { Back up existing file if needed }
  1767. if FOptions.MakeBackups and NewFileExists(FN) then begin
  1768. BackupFN := PathChangeExt(FN, '.~is');
  1769. DeleteFile(BackupFN);
  1770. if not RenameFile(FN, BackupFN) then
  1771. raise Exception.Create('Error creating backup file. Could not save file');
  1772. end;
  1773. { Delete existing file }
  1774. if not DeleteFile(FN) and (GetLastError <> ERROR_FILE_NOT_FOUND) then
  1775. raise Exception.CreateFmt('Error removing existing file (code %d). Could not save file',
  1776. [GetLastError]);
  1777. except
  1778. DeleteFile(TempFN);
  1779. raise;
  1780. end;
  1781. { Rename temporary file.
  1782. Note: This is outside the try..except because we already deleted the
  1783. existing file, and don't want the temp file also deleted in the unlikely
  1784. event that the rename fails. }
  1785. if not RenameFile(TempFN, FN) then
  1786. raise Exception.CreateFmt('Error renaming temporary file (code %d). Could not save file',
  1787. [GetLastError]);
  1788. GetLastWriteTimeOfFile(FN, @AMemo.FileLastWriteTime);
  1789. end;
  1790. var
  1791. FN: String;
  1792. begin
  1793. Result := False;
  1794. var OldName := AMemo.Filename;
  1795. if SaveAs or (AMemo.Filename = '') then begin
  1796. if AMemo <> FMainMemo then
  1797. raise Exception.Create('Internal error: AMemo <> FMainMemo');
  1798. FN := AMemo.Filename;
  1799. if not NewGetSaveFileName('', FN, '', SCompilerOpenFilter, 'iss', Handle) then Exit;
  1800. FN := PathExpand(FN);
  1801. SaveMemoTo(FN);
  1802. AMemo.Filename := FN;
  1803. UpdateCaption;
  1804. end else
  1805. SaveMemoTo(AMemo.Filename);
  1806. AMemo.SetSavePoint;
  1807. if not FOptions.UndoAfterSave then
  1808. AMemo.ClearUndo(False);
  1809. Result := True;
  1810. if AMemo = FMainMemo then begin
  1811. ModifyMRUMainFilesList(AMemo.Filename, True);
  1812. if PathCompare(AMemo.Filename, OldName) <> 0 then begin
  1813. if OldName <> '' then begin
  1814. DeleteBreakPointLines(OldName);
  1815. DeleteKnownIncludedAndHiddenFiles(OldName);
  1816. end;
  1817. BuildAndSaveBreakPointLines(AMemo);
  1818. BuildAndSaveKnownIncludedAndHiddenFiles;
  1819. end;
  1820. end;
  1821. end;
  1822. function TMainForm.ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
  1823. function PromptToSaveMemo(const AMemo: TIDEScintFileEdit): Boolean;
  1824. var
  1825. FileTitle: String;
  1826. begin
  1827. Result := True;
  1828. if AMemo.Modified then begin
  1829. FileTitle := GetFileTitle(AMemo.Filename);
  1830. case MsgBox('The text in the ' + FileTitle + ' file has changed.'#13#10#13#10 +
  1831. 'Do you want to save the changes?', SCompilerFormCaption, mbError,
  1832. MB_YESNOCANCEL) of
  1833. IDYES: Result := SaveFile(AMemo, False);
  1834. IDNO: ;
  1835. else
  1836. Result := False;
  1837. end;
  1838. end;
  1839. end;
  1840. var
  1841. Memo: TIDEScintFileEdit;
  1842. begin
  1843. if FCompiling then begin
  1844. MsgBox('Please stop the compile process before performing this command.',
  1845. SCompilerFormCaption, mbError, MB_OK);
  1846. Result := False;
  1847. Exit;
  1848. end;
  1849. if FDebugging and not AskToDetachDebugger then begin
  1850. Result := False;
  1851. Exit;
  1852. end;
  1853. Result := True;
  1854. if PromptToSave then begin
  1855. for Memo in FFileMemos do begin
  1856. if Memo.Used then begin
  1857. Result := PromptToSaveMemo(Memo);
  1858. if not Result then
  1859. Exit;
  1860. end;
  1861. end;
  1862. end;
  1863. end;
  1864. procedure TMainForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
  1865. begin
  1866. AddLines(CompilerOutputList, S, TObject(Kind), False, alpNone, 0);
  1867. CompilerOutputList.Update;
  1868. end;
  1869. procedure TMainForm.DebugLogMessage(const S: String);
  1870. begin
  1871. AddLines(DebugOutputList, S, nil, True, alpTimestamp, FDebugLogListTimestampsWidth);
  1872. DebugOutputList.Update;
  1873. end;
  1874. procedure TMainForm.DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
  1875. begin
  1876. DebugCallStackList.Clear;
  1877. AddLines(DebugCallStackList, CallStack, nil, True, alpCountdown, Integer(FCallStackCount-1));
  1878. DebugCallStackList.Items.Insert(0, '*** [Code] Call Stack');
  1879. DebugCallStackList.Update;
  1880. end;
  1881. type
  1882. PAppData = ^TAppData;
  1883. TAppData = record
  1884. Form: TMainForm;
  1885. Filename: String;
  1886. Lines: TStringList;
  1887. CurLineNumber: Integer;
  1888. CurLine: String;
  1889. OutputExe: String;
  1890. DebugInfo: Pointer;
  1891. ErrorMsg: String;
  1892. ErrorFilename: String;
  1893. ErrorLine: Integer;
  1894. Aborted: Boolean;
  1895. end;
  1896. function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
  1897. AppData: NativeInt): Integer; stdcall;
  1898. procedure DecodeIncludedFilenames(P: PChar; const IncludedFiles: TIncludedFiles;
  1899. const AutoHideNew: Boolean; const HiddenFiles: TStringList);
  1900. begin
  1901. if P <> nil then begin
  1902. var PrevIncludedFiles: TStringList := nil;
  1903. try
  1904. if AutoHideNew then begin
  1905. PrevIncludedFiles := TStringList.Create;
  1906. for var IncludedFile in IncludedFiles do
  1907. PrevIncludedFiles.Add(IncludedFile.Filename);
  1908. PrevIncludedFiles.UseLocale := False;
  1909. PrevIncludedFiles.Sorted := True; { Just for lookup performance }
  1910. end;
  1911. IncludedFiles.Clear;
  1912. var I := 0;
  1913. while P^ <> #0 do begin
  1914. if not IsISPPBuiltins(P) then begin
  1915. const IncludedFile = TIncludedFile.Create;
  1916. IncludedFile.Filename := GetCleanFileNameOfFile(P);
  1917. IncludedFile.CompilerFileIndex := I;
  1918. IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
  1919. @IncludedFile.LastWriteTime);
  1920. IncludedFiles.Add(IncludedFile);
  1921. if AutoHideNew and (PrevIncludedFiles.IndexOf(IncludedFile.Filename) = -1) then begin
  1922. { This is a new include file we didn't know about yet }
  1923. if HiddenFiles.IndexOf(IncludedFile.Filename) = -1 then { Should always be True }
  1924. HiddenFiles.Add(IncludedFile.Filename);
  1925. end;
  1926. end;
  1927. Inc(P, StrLen(P) + 1);
  1928. Inc(I);
  1929. end;
  1930. finally
  1931. PrevIncludedFiles.Free;
  1932. end;
  1933. end else
  1934. IncludedFiles.Clear;
  1935. end;
  1936. procedure CleanHiddenFiles(const IncludedFiles: TIncludedFiles; const HiddenFiles: TStringList);
  1937. var
  1938. HiddenFileIncluded: array of Boolean;
  1939. begin
  1940. if HiddenFiles.Count > 0 then begin
  1941. { Clean previously hidden files which are no longer included }
  1942. if IncludedFiles.Count > 0 then begin
  1943. SetLength(HiddenFileIncluded, HiddenFiles.Count);
  1944. for var I := 0 to HiddenFiles.Count-1 do
  1945. HiddenFileIncluded[I] := False;
  1946. for var I := 0 to IncludedFiles.Count-1 do begin
  1947. var IncludedFile := IncludedFiles[I];
  1948. var HiddenFileIndex := HiddenFiles.IndexOf(IncludedFile.Filename);
  1949. if HiddenFileIndex <> -1 then
  1950. HiddenFileIncluded[HiddenFileIndex] := True;
  1951. end;
  1952. for var I := HiddenFiles.Count-1 downto 0 do
  1953. if not HiddenFileIncluded[I] then
  1954. HiddenFiles.Delete(I);
  1955. end else
  1956. HiddenFiles.Clear;
  1957. end;
  1958. end;
  1959. begin
  1960. Result := iscrSuccess;
  1961. with PAppData(AppData)^ do
  1962. case Code of
  1963. iscbReadScript:
  1964. begin
  1965. if Data.Reset then
  1966. CurLineNumber := 0;
  1967. if CurLineNumber < Lines.Count then begin
  1968. CurLine := Lines[CurLineNumber];
  1969. Data.LineRead := PChar(CurLine);
  1970. Inc(CurLineNumber);
  1971. end;
  1972. end;
  1973. iscbNotifyStatus:
  1974. if Data.Warning then
  1975. Form.StatusMessage(smkWarning, Data.StatusMsg)
  1976. else
  1977. Form.StatusMessage(smkNormal, Data.StatusMsg);
  1978. iscbNotifyIdle:
  1979. begin
  1980. Form.UpdateCompileStatusPanels(Data.CompressProgress,
  1981. Data.CompressProgressMax, Data.SecondsRemaining,
  1982. Data.BytesCompressedPerSecond);
  1983. { We have to use HandleMessage instead of ProcessMessages so that
  1984. Application.Idle is called. Otherwise, Flat TSpeedButton's don't
  1985. react to the mouse being moved over them.
  1986. Unfortunately, HandleMessage by default calls WaitMessage. To avoid
  1987. this we have an Application.OnIdle handler which sets Done to False
  1988. while compiling is in progress - see AppOnIdle.
  1989. The GetQueueStatus check below is just an optimization; calling
  1990. HandleMessage when there are no messages to process wastes CPU. }
  1991. if GetQueueStatus(QS_ALLINPUT) <> 0 then begin
  1992. Form.FBecameIdle := False;
  1993. repeat
  1994. Application.HandleMessage;
  1995. { AppOnIdle sets FBecameIdle to True when it's called, which
  1996. indicates HandleMessage didn't find any message to process }
  1997. until Form.FBecameIdle;
  1998. end;
  1999. if Form.FCompileWantAbort then
  2000. Result := iscrRequestAbort;
  2001. end;
  2002. iscbNotifyPreproc:
  2003. begin
  2004. Form.FPreprocessorOutput := TrimRight(Data.PreprocessedScript);
  2005. { Also stores last write time }
  2006. DecodeIncludedFilenames(Data.IncludedFilenames, Form.FIncludedFiles,
  2007. Form.FOptions.AutoHideNewIncludedFiles, Form.FHiddenFiles);
  2008. CleanHiddenFiles(Form.FIncludedFiles, Form.FHiddenFiles);
  2009. Form.InvalidateStatusPanel(spHiddenFilesCount);
  2010. Form.BuildAndSaveKnownIncludedAndHiddenFiles;
  2011. end;
  2012. iscbNotifySuccess:
  2013. begin
  2014. OutputExe := Data.OutputExeFilename;
  2015. if Form.FCompilerVersion.BinVersion >= $3000001 then begin
  2016. {$IFNDEF WIN64}
  2017. if Data.DebugInfoSize > Cardinal(High(Integer)) then
  2018. raise Exception.Create('Unexpected Data.DebugInfoSize value');
  2019. {$ENDIF}
  2020. DebugInfo := AllocMem(NativeInt(Data.DebugInfoSize));
  2021. UMove(Data.DebugInfo^, DebugInfo^, Data.DebugInfoSize);
  2022. end else
  2023. DebugInfo := nil;
  2024. end;
  2025. iscbNotifyError:
  2026. begin
  2027. if Assigned(Data.ErrorMsg) then
  2028. ErrorMsg := Data.ErrorMsg
  2029. else
  2030. Aborted := True;
  2031. ErrorFilename := Data.ErrorFilename;
  2032. ErrorLine := Data.ErrorLine;
  2033. end;
  2034. end;
  2035. end;
  2036. procedure TMainForm.CompileFile(AFilename: String; const ReadFromFile: Boolean);
  2037. function GetMemoFromErrorFilename(const ErrorFilename: String): TIDEScintFileEdit;
  2038. var
  2039. Memo: TIDEScintFileEdit;
  2040. begin
  2041. if ErrorFilename = '' then
  2042. Result := FMainMemo
  2043. else begin
  2044. if FOptions.OpenIncludedFiles then begin
  2045. for Memo in FFileMemos do begin
  2046. if Memo.Used and (PathCompare(Memo.Filename, ErrorFilename) = 0) then begin
  2047. Result := Memo;
  2048. Exit;
  2049. end;
  2050. end;
  2051. end;
  2052. Result := nil;
  2053. end;
  2054. end;
  2055. var
  2056. SourcePath, S, Options: String;
  2057. Params: TCompileScriptParamsEx;
  2058. AppData: TAppData;
  2059. StartTime, ElapsedTime, ElapsedSeconds: DWORD;
  2060. I: Integer;
  2061. Memo: TIDEScintFileEdit;
  2062. OldActiveMemo: TIDEScintEdit;
  2063. begin
  2064. if FCompiling then begin
  2065. { Shouldn't get here, but just in case... }
  2066. MsgBox('A compile is already in progress.', SCompilerFormCaption, mbError, MB_OK);
  2067. Abort;
  2068. end;
  2069. if not ReadFromFile then begin
  2070. if FOptions.OpenIncludedFiles then begin
  2071. { Included files must always be saved since they're not read from the editor by the compiler }
  2072. for Memo in FFileMemos do begin
  2073. if (Memo <> FMainMemo) and Memo.Used and Memo.Modified then begin
  2074. if FOptions.Autosave then begin
  2075. if not SaveFile(Memo, False) then
  2076. Abort;
  2077. end else begin
  2078. case MsgBox('The text in the ' + Memo.Filename + ' file has changed and must be saved before compiling.'#13#10#13#10 +
  2079. 'Save the changes and continue?', SCompilerFormCaption, mbError,
  2080. MB_YESNO) of
  2081. IDYES:
  2082. if not SaveFile(Memo, False) then
  2083. Abort;
  2084. else
  2085. Abort;
  2086. end;
  2087. end;
  2088. end;
  2089. end;
  2090. end;
  2091. { Save main file if requested }
  2092. if FOptions.Autosave and FMainMemo.Modified then begin
  2093. if not SaveFile(FMainMemo, False) then
  2094. Abort;
  2095. end else if FMainMemo.Filename = '' then begin
  2096. case MsgBox('Would you like to save the script before compiling?' +
  2097. SNewLine2 + 'If you answer No, the compiled installation will be ' +
  2098. 'placed under your My Documents folder by default.',
  2099. SCompilerFormCaption, mbConfirmation, MB_YESNOCANCEL) of
  2100. IDYES:
  2101. if not SaveFile(FMainMemo, False) then
  2102. Abort;
  2103. IDNO: ;
  2104. else
  2105. Abort;
  2106. end;
  2107. end;
  2108. AFilename := FMainMemo.Filename;
  2109. end; {else: Command line compile, AFilename already set. }
  2110. DestroyDebugInfo;
  2111. OldActiveMemo := FActiveMemo;
  2112. AppData := Default(TAppData);
  2113. AppData.Lines := TStringList.Create;
  2114. try
  2115. FBuildAnimationFrame := 0;
  2116. FProgress := 0;
  2117. FProgressMax := 0;
  2118. FTaskbarProgressValue := 0;
  2119. FActiveMemo.CancelAutoCompleteAndCallTip;
  2120. FActiveMemo.Cursor := crAppStart;
  2121. FActiveMemo.SetCursorID(999); { hack to keep it from overriding Cursor }
  2122. CompilerOutputList.Cursor := crAppStart;
  2123. for Memo in FFileMemos do
  2124. Memo.ReadOnly := True;
  2125. UpdateEditModeStatusPanel;
  2126. HideError;
  2127. CompilerOutputList.Clear;
  2128. SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  2129. DebugOutputList.Clear;
  2130. SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  2131. DebugCallStackList.Clear;
  2132. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  2133. OutputTabSet.TabIndex := tiCompilerOutput;
  2134. SetStatusPanelVisible(True);
  2135. SourcePath := GetSourcePath(AFilename);
  2136. FillChar(Params, SizeOf(Params), 0);
  2137. Params.Size := SizeOf(Params);
  2138. Params.CompilerPath := nil;
  2139. Params.SourcePath := PChar(SourcePath);
  2140. Params.CallbackProc := CompilerCallbackProc;
  2141. Params.AppData := NativeInt(@AppData);
  2142. Options := '';
  2143. for I := 0 to FSignTools.Count-1 do
  2144. Options := Options + AddSignToolParam(FSignTools[I]);
  2145. Params.Options := PChar(Options);
  2146. AppData.Form := Self;
  2147. AppData.CurLineNumber := 0;
  2148. AppData.Aborted := False;
  2149. I := ReadScriptLines(AppData.Lines, ReadFromFile, AFilename, FMainMemo);
  2150. if I <> -1 then begin
  2151. if not ReadFromFile then begin
  2152. MoveCaretAndActivateMemo(FMainMemo, I, False);
  2153. SetErrorLine(FMainMemo, I);
  2154. end;
  2155. raise Exception.CreateFmt(SCompilerIllegalNullChar, [I + 1]);
  2156. end;
  2157. StartTime := GetTickCount;
  2158. StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)]));
  2159. StatusMessage(smkStartEnd, '');
  2160. FCompiling := True;
  2161. FCompileWantAbort := False;
  2162. UpdateRunMenu;
  2163. UpdateCaption;
  2164. SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
  2165. AppData.Filename := AFilename;
  2166. {$IFNDEF STATICCOMPILER}
  2167. if ISDllCompileScript(Params) <> isceNoError then begin
  2168. {$ELSE}
  2169. if ISCompileScript(Params, False) <> isceNoError then begin
  2170. {$ENDIF}
  2171. StatusMessage(smkError, SCompilerStatusErrorAborted);
  2172. if not ReadFromFile and (AppData.ErrorLine > 0) then begin
  2173. Memo := GetMemoFromErrorFilename(AppData.ErrorFilename);
  2174. if Memo <> nil then begin
  2175. { Move the caret to the line number the error occurred on }
  2176. MoveCaretAndActivateMemo(Memo, AppData.ErrorLine - 1, False);
  2177. SetErrorLine(Memo, AppData.ErrorLine - 1);
  2178. end;
  2179. end;
  2180. if not AppData.Aborted then begin
  2181. S := '';
  2182. if AppData.ErrorFilename <> '' then
  2183. S := 'File: ' + AppData.ErrorFilename + SNewLine2;
  2184. if AppData.ErrorLine > 0 then
  2185. S := S + Format('Line %d:' + SNewLine, [AppData.ErrorLine]);
  2186. S := S + AppData.ErrorMsg;
  2187. SetAppTaskbarProgressState(tpsError);
  2188. MsgBox(S, 'Compiler Error', mbCriticalError, MB_OK)
  2189. end;
  2190. Abort;
  2191. end;
  2192. ElapsedTime := GetTickCount - StartTime;
  2193. ElapsedSeconds := ElapsedTime div 1000;
  2194. StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
  2195. Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, FormatSettings.TimeSeparator,
  2196. ElapsedSeconds mod 60, FormatSettings.DecimalSeparator, ElapsedTime mod 1000])]));
  2197. finally
  2198. AppData.Lines.Free;
  2199. FCompiling := False;
  2200. SetLowPriority(False, FSavePriorityClass);
  2201. OldActiveMemo.Cursor := crDefault;
  2202. OldActiveMemo.SetCursorID(SC_CURSORNORMAL);
  2203. CompilerOutputList.Cursor := crDefault;
  2204. for Memo in FFileMemos do
  2205. Memo.ReadOnly := False;
  2206. UpdateEditModeStatusPanel;
  2207. UpdateRunMenu;
  2208. UpdateCaption;
  2209. UpdatePreprocMemos;
  2210. if AppData.DebugInfo <> nil then begin
  2211. ParseDebugInfo(AppData.DebugInfo); { Must be called after UpdateIncludedFilesMemos }
  2212. FreeMem(AppData.DebugInfo);
  2213. end;
  2214. InvalidateStatusPanel(spCompileIcon);
  2215. InvalidateStatusPanel(spCompileProgress);
  2216. SetAppTaskbarProgressState(tpsNoProgress);
  2217. StatusBar.Panels[spExtraStatus].Text := '';
  2218. end;
  2219. FCompiledExe := AppData.OutputExe;
  2220. FModifiedAnySinceLastCompile := False;
  2221. FModifiedAnySinceLastCompileAndGo := False;
  2222. end;
  2223. procedure TMainForm.SyncEditorOptions;
  2224. const
  2225. SquigglyStyles: array[Boolean] of Integer = (INDIC_HIDDEN, INDIC_SQUIGGLE);
  2226. WhiteSpaceStyles: array[Boolean] of Integer = (SCWS_INVISIBLE, SCWS_VISIBLEALWAYS);
  2227. var
  2228. Memo: TIDEScintEdit;
  2229. begin
  2230. for Memo in FMemos do begin
  2231. Memo.UseStyleAttributes := FOptions.UseSyntaxHighlighting;
  2232. Memo.Call(SCI_INDICSETSTYLE, minSquiggly, SquigglyStyles[FOptions.UnderlineErrors]);
  2233. Memo.Call(SCI_SETVIEWWS, WhiteSpaceStyles[FOptions.ShowWhiteSpace], 0);
  2234. if FOptions.CursorPastEOL then
  2235. Memo.VirtualSpaceOptions := [svsRectangularSelection, svsUserAccessible, svsNoWrapLineStart]
  2236. else
  2237. Memo.VirtualSpaceOptions := [];
  2238. Memo.FillSelectionToEdge := FOptions.CursorPastEOL;
  2239. Memo.TabWidth := FOptions.TabWidth;
  2240. Memo.UseTabCharacter := FOptions.UseTabCharacter;
  2241. Memo.KeyMappingType := FOptions.MemoKeyMappingType;
  2242. if Memo = FMainMemo then begin
  2243. SetFakeShortCut(ESelectNextOccurrence, FMainMemo.GetComplexCommandShortCut(ccSelectNextOccurrence));
  2244. SetFakeShortCut(ESelectAllOccurrences, FMainMemo.GetComplexCommandShortCut(ccSelectAllOccurrences));
  2245. SetFakeShortCut(ESelectAllFindMatches, FMainMemo.GetComplexCommandShortCut(ccSelectAllFindMatches));
  2246. SetFakeShortCut(EFoldLine, FMainMemo.GetComplexCommandShortCut(ccFoldLine));
  2247. SetFakeShortCut(EUnfoldLine, FMainMemo.GetComplexCommandShortCut(ccUnfoldLine));
  2248. SetFakeShortCut(EToggleLinesComment, FMainMemo.GetComplexCommandShortCut(ccToggleLinesComment));
  2249. SetFakeShortCut(EBraceMatch, FMainMemo.GetComplexCommandShortCut(ccBraceMatch));
  2250. end;
  2251. Memo.SmartHome := FOptions.SmartHome;
  2252. Memo.UseFolding := FOptions.UseFolding;
  2253. Memo.WordWrap := FOptions.WordWrap;
  2254. if FOptions.IndentationGuides then
  2255. Memo.IndentationGuides := sigLookBoth
  2256. else
  2257. Memo.IndentationGuides := sigNone;
  2258. Memo.LineNumbers := FOptions.GutterLineNumbers;
  2259. end;
  2260. end;
  2261. procedure TMainForm.FMenuClick(Sender: TObject);
  2262. begin
  2263. UpdateFileMenu(Sender as TMenuItem);
  2264. end;
  2265. procedure TMainForm.FNewMainFileClick(Sender: TObject);
  2266. begin
  2267. if ConfirmCloseFile(True) then
  2268. NewMainFile;
  2269. end;
  2270. procedure TMainForm.FNewMainFileUserWizardClick(Sender: TObject);
  2271. begin
  2272. if ConfirmCloseFile(True) then
  2273. NewMainFileUsingWizard;
  2274. end;
  2275. procedure TMainForm.ShowOpenMainFileDialog(const Examples: Boolean);
  2276. var
  2277. InitialDir, Filename: String;
  2278. begin
  2279. if Examples then begin
  2280. InitialDir := PathExtractPath(NewParamStr(0)) + 'Examples';
  2281. Filename := PathExtractPath(NewParamStr(0)) + 'Examples\Example1.iss';
  2282. end
  2283. else begin
  2284. InitialDir := PathExtractDir(FMainMemo.Filename);
  2285. Filename := '';
  2286. end;
  2287. if ConfirmCloseFile(True) then
  2288. if NewGetOpenFileName('', Filename, InitialDir, SCompilerOpenFilter, 'iss', Handle) then begin
  2289. { Check if user actually wants to open tab for an included file }
  2290. if FOptions.OpenIncludedFiles then begin
  2291. for var IncludedFile in FIncludedFiles do begin
  2292. if PathSame(IncludedFile.Filename, Filename) and
  2293. (MsgBox('The selected file is an #include file. Go to its tab instead of opening it as the new main file?',
  2294. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES) then begin
  2295. if IncludedFile.Memo <> nil then begin
  2296. const HiddenFileIndex = FHiddenFiles.IndexOf(Filename);
  2297. if HiddenFileIndex <> -1 then
  2298. ReopenTabOrTabs(HiddenFileIndex, True)
  2299. else
  2300. MemosTabSet.TabIndex := MemoToTabIndex(IncludedFile.Memo);
  2301. Exit;
  2302. end else { We know about this file but it has no memo because MaxMemos was reached (or there was some error loading the file) }
  2303. if MsgBox('The selected file is not available as a tab. Opening as the new main file instead.',
  2304. SCompilerFormCaption, mbError, MB_OKCANCEL) = IDCANCEL then
  2305. Exit;
  2306. end;
  2307. end;
  2308. end;
  2309. { Not an included file, or user said no: open as main file }
  2310. OpenFile(FMainMemo, Filename, False);
  2311. end;
  2312. end;
  2313. procedure TMainForm.FOpenMainFileClick(Sender: TObject);
  2314. begin
  2315. ShowOpenMainFileDialog(False);
  2316. end;
  2317. procedure TMainForm.FSaveClick(Sender: TObject);
  2318. begin
  2319. SaveFile((FActiveMemo as TIDEScintFileEdit), Sender = FSaveMainFileAs);
  2320. end;
  2321. procedure TMainForm.FSaveEncodingItemClick(Sender: TObject);
  2322. begin
  2323. var Memo := (FActiveMemo as TIDEScintFileEdit);
  2324. var OldSaveEncoding := Memo.SaveEncoding;
  2325. if Sender = FSaveEncodingUTF8WithBOM then
  2326. Memo.SaveEncoding := seUTF8WithBOM
  2327. else if Sender = FSaveEncodingUTF8WithoutBOM then
  2328. Memo.SaveEncoding := seUTF8WithoutBOM
  2329. else
  2330. Memo.SaveEncoding := seAuto;
  2331. if Memo.SaveEncoding <> OldSaveEncoding then
  2332. Memo.ForceModifiedState;
  2333. end;
  2334. procedure TMainForm.FSaveAllClick(Sender: TObject);
  2335. var
  2336. Memo: TIDEScintFileEdit;
  2337. begin
  2338. for Memo in FFileMemos do
  2339. if Memo.Used and Memo.Modified then
  2340. SaveFile(Memo, False);
  2341. end;
  2342. procedure TMainForm.FPrintClick(Sender: TObject);
  2343. procedure SetupNonDarkPrintStyler(var PrintStyler: TInnoSetupStyler; var PrintTheme: TTheme;
  2344. var OldStyler: TScintCustomStyler; var OldTheme: TTheme);
  2345. begin
  2346. { Not the most pretty code, would ideally make a copy of FActiveMemo and print that instead or
  2347. somehow convince Scintilla to use different print styles but don't know of a good way to do
  2348. either. Using SC_PRINT_COLOURONWHITE doesn't help, this gives white on white in dark mode. }
  2349. PrintStyler := TInnoSetupStyler.Create(nil);
  2350. PrintTheme := TTheme.Create;
  2351. PrintStyler.ISPPInstalled := ISPPInstalled;
  2352. PrintStyler.Theme := PrintTheme;
  2353. if not FTheme.Dark then
  2354. PrintTheme.Typ := FTheme.Typ
  2355. else
  2356. PrintTheme.Typ := ttModernLight;
  2357. OldStyler := FActiveMemo.Styler;
  2358. OldTheme := FActiveMemo.Theme;
  2359. FActiveMemo.Styler := PrintStyler;
  2360. FActiveMemo.Theme := PrintTheme;
  2361. FActiveMemo.UpdateThemeColorsAndStyleAttributes;
  2362. end;
  2363. procedure DeinitPrintStyler(const PrintStyler: TInnoSetupStyler; const PrintTheme: TTheme;
  2364. const OldStyler: TScintCustomStyler; const OldTheme: TTheme);
  2365. begin
  2366. if (OldStyler <> nil) or (OldTheme <> nil) then begin
  2367. if OldStyler <> nil then
  2368. FActiveMemo.Styler := OldStyler;
  2369. if OldTheme <> nil then
  2370. FActiveMemo.Theme := OldTheme;
  2371. FActiveMemo.UpdateThemeColorsAndStyleAttributes;
  2372. end;
  2373. if PrintTheme <> FTheme then
  2374. PrintTheme.Free;
  2375. PrintStyler.Free;
  2376. end;
  2377. var
  2378. PrintStyler: TInnoSetupStyler;
  2379. OldStyler: TScintCustomStyler;
  2380. PrintTheme, OldTheme: TTheme;
  2381. HeaderMemo: TIDEScintFileEdit;
  2382. FileTitle, S: String;
  2383. pdlg: TPrintDlg;
  2384. hdc: Windows.HDC;
  2385. rectMargins, rectPhysMargins, rectSetup, rcw: TRect;
  2386. ptPage, ptDpi: TPoint;
  2387. headerLineHeight, footerLineHeight: Integer;
  2388. fontHeader, fontFooter: HFONT;
  2389. tm: TTextMetric;
  2390. di: TDocInfo;
  2391. lengthDoc, lengthDocMax, lengthPrinted: Integer;
  2392. frPrint: TScintRangeToFormat;
  2393. pageNum: Integer;
  2394. printPage: Boolean;
  2395. ta: UINT;
  2396. sHeader, sFooter: String;
  2397. pen, penOld: HPEN;
  2398. begin
  2399. if FActiveMemo is TIDEScintFileEdit then
  2400. HeaderMemo := TIDEScintFileEdit(FActiveMemo)
  2401. else
  2402. HeaderMemo := FMainMemo;
  2403. sHeader := HeaderMemo.Filename;
  2404. FileTitle := GetFileTitle(HeaderMemo.Filename);
  2405. if HeaderMemo <> FActiveMemo then begin
  2406. S := ' - ' + MemosTabSet.Tabs[MemoToTabIndex(FActiveMemo)];
  2407. sHeader := Format('%s %s', [sHeader, S]);
  2408. FileTitle := Format('%s %s', [FileTitle, S]);
  2409. end;
  2410. sHeader := Format('%s - %s', [sHeader, DateTimeToStr(Now())]);
  2411. { Based on SciTE 5.50's SciTEWin::Print }
  2412. ZeroMemory(@pdlg, SizeOf(pdlg));
  2413. pdlg.lStructSize := SizeOf(pdlg);
  2414. pdlg.hwndOwner := Handle;
  2415. pdlg.hInstance := hInstance;
  2416. pdlg.Flags := PD_USEDEVMODECOPIES or PD_ALLPAGES or PD_RETURNDC;
  2417. pdlg.nFromPage := 1;
  2418. pdlg.nToPage := 1;
  2419. pdlg.nMinPage := 1;
  2420. pdlg.nMaxPage := $ffff; // We do not know how many pages in the document until the printer is selected and the paper size is known.
  2421. pdlg.nCopies := 1;
  2422. pdlg.hDC := 0;
  2423. pdlg.hDevMode := FDevMode;
  2424. pdlg.hDevNames := FDevNames;
  2425. // See if a range has been selected
  2426. var rangeSelection := FActiveMemo.Selection;
  2427. if rangeSelection.StartPos = rangeSelection.EndPos then
  2428. pdlg.Flags := pdlg.Flags or PD_NOSELECTION
  2429. else
  2430. pdlg.Flags := pdlg.Flags or PD_SELECTION;
  2431. if not PrintDlg(pdlg) then
  2432. Exit;
  2433. PrintStyler := nil;
  2434. PrintTheme := nil;
  2435. OldStyler := nil;
  2436. OldTheme := nil;
  2437. try
  2438. if FTheme.Dark then
  2439. SetupNonDarkPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme)
  2440. else
  2441. PrintTheme := FTheme;
  2442. FDevMode := pdlg.hDevMode;
  2443. FDevNames := pdlg.hDevNames;
  2444. hdc := pdlg.hDC;
  2445. // Get printer resolution
  2446. ptDpi.x := GetDeviceCaps(hdc, LOGPIXELSX); // dpi in X direction
  2447. ptDpi.y := GetDeviceCaps(hdc, LOGPIXELSY); // dpi in Y direction
  2448. // Start by getting the physical page size (in device units).
  2449. ptPage.x := GetDeviceCaps(hdc, PHYSICALWIDTH); // device units
  2450. ptPage.y := GetDeviceCaps(hdc, PHYSICALHEIGHT); // device units
  2451. // Get the dimensions of the unprintable
  2452. // part of the page (in device units).
  2453. rectPhysMargins.left := GetDeviceCaps(hdc, PHYSICALOFFSETX);
  2454. rectPhysMargins.top := GetDeviceCaps(hdc, PHYSICALOFFSETY);
  2455. // To get the right and lower unprintable area,
  2456. // we take the entire width and height of the paper and
  2457. // subtract everything else.
  2458. rectPhysMargins.right := ptPage.x // total paper width
  2459. - GetDeviceCaps(hdc, HORZRES) // printable width
  2460. - rectPhysMargins.left; // left unprintable margin
  2461. rectPhysMargins.bottom := ptPage.y // total paper height
  2462. - GetDeviceCaps(hdc, VERTRES) // printable height
  2463. - rectPhysMargins.top; // right unprintable margin
  2464. // At this point, rectPhysMargins contains the widths of the
  2465. // unprintable regions on all four sides of the page in device units.
  2466. (*
  2467. // Take in account the page setup given by the user (if one value is not null)
  2468. if (pagesetupMargin.left != 0 || pagesetupMargin.right != 0 ||
  2469. pagesetupMargin.top != 0 || pagesetupMargin.bottom != 0) {
  2470. GUI::Rectangle rectSetup;
  2471. // Convert the hundredths of millimeters (HiMetric) or
  2472. // thousandths of inches (HiEnglish) margin values
  2473. // from the Page Setup dialog to device units.
  2474. // (There are 2540 hundredths of a mm in an inch.)
  2475. TCHAR localeInfo[3];
  2476. GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, localeInfo, 3);
  2477. if (localeInfo[0] == '0') { // Metric system. '1' is US System *)
  2478. rectSetup.left := MulDiv(500 {pagesetupMargin.left}, ptDpi.x, 2540);
  2479. rectSetup.top := MulDiv(500 {pagesetupMargin.top}, ptDpi.y, 2540);
  2480. rectSetup.right := MulDiv(500 {pagesetupMargin.right}, ptDpi.x, 2540);
  2481. rectSetup.bottom := MulDiv(500 {pagesetupMargin.bottom}, ptDpi.y, 2540);
  2482. (* } else {
  2483. rectSetup.left = MulDiv(pagesetupMargin.left, ptDpi.x, 1000);
  2484. rectSetup.top = MulDiv(pagesetupMargin.top, ptDpi.y, 1000);
  2485. rectSetup.right = MulDiv(pagesetupMargin.right, ptDpi.x, 1000);
  2486. rectSetup.bottom = MulDiv(pagesetupMargin.bottom, ptDpi.y, 1000);
  2487. } *)
  2488. // Don't reduce margins below the minimum printable area
  2489. rectMargins.left := Max(rectPhysMargins.left, rectSetup.left);
  2490. rectMargins.top := Max(rectPhysMargins.top, rectSetup.top);
  2491. rectMargins.right := Max(rectPhysMargins.right, rectSetup.right);
  2492. rectMargins.bottom := Max(rectPhysMargins.bottom, rectSetup.bottom);
  2493. (*
  2494. } else {
  2495. rectMargins := rectPhysMargins;
  2496. }
  2497. *)
  2498. // rectMargins now contains the values used to shrink the printable
  2499. // area of the page.
  2500. // Convert device coordinates into logical coordinates
  2501. DPtoLP(hdc, rectMargins, 2);
  2502. DPtoLP(hdc, rectPhysMargins, 2);
  2503. // Convert page size to logical units and we're done!
  2504. DPtoLP(hdc, ptPage, 1);
  2505. headerLineHeight := MulDiv(9, ptDpi.y, 72);
  2506. fontHeader := CreateFont(headerLineHeight, 0, 0, 0, FW_REGULAR, 1, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
  2507. SelectObject(hdc, fontHeader);
  2508. GetTextMetrics(hdc, &tm);
  2509. headerLineHeight := tm.tmHeight + tm.tmExternalLeading;
  2510. footerLineHeight := MulDiv(9, ptDpi.y, 72);
  2511. fontFooter := CreateFont(footerLineHeight, 0, 0, 0, FW_REGULAR, 0, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
  2512. SelectObject(hdc, fontFooter);
  2513. GetTextMetrics(hdc, &tm);
  2514. footerLineHeight := tm.tmHeight + tm.tmExternalLeading;
  2515. ZeroMemory(@di, SizeOf(di));
  2516. di.cbSize := SizeOf(di);
  2517. di.lpszDocName := PChar(FileTitle);
  2518. di.lpszOutput := nil;
  2519. di.lpszDatatype := nil;
  2520. di.fwType := 0;
  2521. if StartDoc(hdc, &di) < 0 then begin
  2522. DeleteDC(hdc);
  2523. DeleteObject(fontHeader);
  2524. DeleteObject(fontFooter);
  2525. MsgBox('Can not start printer document.', SCompilerFormCaption, mbError, MB_OK);
  2526. Exit;
  2527. end;
  2528. lengthDocMax := FActiveMemo.GetRawTextLength;
  2529. // PD_SELECTION -> requested to print selection.
  2530. lengthDoc := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.EndPos, lengthDocMax);
  2531. lengthPrinted := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.StartPos, 0);
  2532. // We must subtract the physical margins from the printable area
  2533. frPrint.hdc := hdc;
  2534. frPrint.hdcTarget := hdc;
  2535. frPrint.rc.left := rectMargins.left - rectPhysMargins.left;
  2536. frPrint.rc.top := rectMargins.top - rectPhysMargins.top;
  2537. frPrint.rc.right := ptPage.x - rectMargins.right - rectPhysMargins.left;
  2538. frPrint.rc.bottom := ptPage.y - rectMargins.bottom - rectPhysMargins.top;
  2539. frPrint.rcPage.left := 0;
  2540. frPrint.rcPage.top := 0;
  2541. frPrint.rcPage.right := ptPage.x - rectPhysMargins.left - rectPhysMargins.right - 1;
  2542. frPrint.rcPage.bottom := ptPage.y - rectPhysMargins.top - rectPhysMargins.bottom - 1;
  2543. frPrint.rc.top := frPrint.rc.top + headerLineHeight + headerLineHeight div 2;
  2544. frPrint.rc.bottom := frPrint.rc.bottom - (footerLineHeight + footerLineHeight div 2);
  2545. // Print each page
  2546. pageNum := 1;
  2547. while lengthPrinted < lengthDoc do begin
  2548. printPage := ((pdlg.Flags and PD_PAGENUMS) = 0) or
  2549. ((pageNum >= pdlg.nFromPage) and (pageNum <= pdlg.nToPage));
  2550. sFooter := Format('- %d -', [pageNum]);
  2551. if printPage then begin
  2552. StartPage(hdc);
  2553. SetTextColor(hdc, TColorRef(ColorToRGB(PrintTheme.Colors[tcFore])));
  2554. SetBkColor(hdc, TColorRef(ColorToRGB(PrintTheme.Colors[tcBack])));
  2555. SelectObject(hdc, fontHeader);
  2556. ta := SetTextAlign(hdc, TA_BOTTOM);
  2557. rcw := Rect(frPrint.rc.left, frPrint.rc.top - headerLineHeight - headerLineHeight div 2,
  2558. frPrint.rc.right, frPrint.rc.top - headerLineHeight div 2);
  2559. rcw.bottom := rcw.top + headerLineHeight;
  2560. ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.top - headerLineHeight div 2,
  2561. ETO_OPAQUE, rcw, sHeader, Length(sHeader), nil);
  2562. SetTextAlign(hdc, ta);
  2563. pen := CreatePen(0, 1, GetTextColor(hdc));
  2564. penOld := SelectObject(hdc, pen);
  2565. MoveToEx(hdc, frPrint.rc.left, frPrint.rc.top - headerLineHeight div 4, nil);
  2566. LineTo(hdc, frPrint.rc.right, frPrint.rc.top - headerLineHeight div 4);
  2567. SelectObject(hdc, penOld);
  2568. DeleteObject(pen);
  2569. end;
  2570. frPrint.chrg.StartPos := lengthPrinted;
  2571. frPrint.chrg.EndPos := lengthDoc;
  2572. lengthPrinted := FActiveMemo.FormatRange(printPage, @frPrint);
  2573. if printPage then begin
  2574. SetTextColor(hdc, TColorRef(ColorToRGB(PrintTheme.Colors[tcFore])));
  2575. SetBkColor(hdc, TColorRef(ColorToRGB(PrintTheme.Colors[tcBack])));
  2576. SelectObject(hdc, fontFooter);
  2577. ta := SetTextAlign(hdc, TA_TOP);
  2578. rcw := Rect(frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 2,
  2579. frPrint.rc.right, frPrint.rc.bottom + footerLineHeight + footerLineHeight div 2);
  2580. ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.bottom + footerLineHeight div 2,
  2581. ETO_OPAQUE, rcw, sFooter, Length(sFooter), nil);
  2582. SetTextAlign(hdc, ta);
  2583. pen := CreatePen(0, 1, GetTextColor(hdc));
  2584. penOld := SelectObject(hdc, pen);
  2585. MoveToEx(hdc, frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 4, nil);
  2586. LineTo(hdc, frPrint.rc.right, frPrint.rc.bottom + footerLineHeight div 4);
  2587. SelectObject(hdc, penOld);
  2588. DeleteObject(pen);
  2589. EndPage(hdc);
  2590. end;
  2591. Inc(pageNum);
  2592. if ((pdlg.Flags and PD_PAGENUMS) <> 0) and (pageNum > pdlg.nToPage) then
  2593. Break;
  2594. end;
  2595. FActiveMemo.FormatRange(False, nil);
  2596. EndDoc(hdc);
  2597. DeleteDC(hdc);
  2598. DeleteObject(fontHeader);
  2599. DeleteObject(fontFooter);
  2600. finally
  2601. DeinitPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme);
  2602. end;
  2603. end;
  2604. procedure TMainForm.FClearRecentClick(Sender: TObject);
  2605. begin
  2606. if MsgBox('Are you sure you want to clear the list of recently opened files?',
  2607. SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
  2608. ClearMRUMainFilesList;
  2609. end;
  2610. procedure TMainForm.FMRUClick(Sender: TObject);
  2611. var
  2612. I: Integer;
  2613. begin
  2614. if ConfirmCloseFile(True) then
  2615. for I := 0 to High(FMRUMainFilesMenuItems) do
  2616. if FMRUMainFilesMenuItems[I] = Sender then begin
  2617. OpenMRUMainFile(FMRUMainFilesList[I]);
  2618. Break;
  2619. end;
  2620. end;
  2621. procedure TMainForm.FExitClick(Sender: TObject);
  2622. begin
  2623. Close;
  2624. end;
  2625. procedure TMainForm.EMenuClick(Sender: TObject);
  2626. begin
  2627. UpdateEditMenu(Sender as TMenuItem);
  2628. end;
  2629. procedure TMainForm.EUndoClick(Sender: TObject);
  2630. begin
  2631. FActiveMemo.Undo;
  2632. end;
  2633. procedure TMainForm.ERedoClick(Sender: TObject);
  2634. begin
  2635. FActiveMemo.Redo;
  2636. end;
  2637. procedure TMainForm.ECutClick(Sender: TObject);
  2638. begin
  2639. FActiveMemo.CutToClipboard;
  2640. end;
  2641. procedure TMainForm.ECopyClick(Sender: TObject);
  2642. begin
  2643. FActiveMemo.CopyToClipboard;
  2644. end;
  2645. procedure TMainForm.EPasteClick(Sender: TObject);
  2646. begin
  2647. if not MultipleSelectionPasteFromClipboard(FActiveMemo) then
  2648. FActiveMemo.PasteFromClipboard;
  2649. end;
  2650. procedure TMainForm.EDeleteClick(Sender: TObject);
  2651. begin
  2652. FActiveMemo.ClearSelection;
  2653. end;
  2654. procedure TMainForm.ESelectAllClick(Sender: TObject);
  2655. begin
  2656. FActiveMemo.SelectAll;
  2657. end;
  2658. procedure TMainForm.ESelectAllOccurrencesClick(Sender: TObject);
  2659. begin
  2660. { Might be called even if ESelectAllOccurrences.Enabled would be False in EMenuClick }
  2661. if FActiveMemo.SelEmpty then begin
  2662. { If the selection is empty then SelectAllOccurrences will actually just select
  2663. the word at caret which is not what we want, so preselect this word ourselves }
  2664. var Range := FActiveMemo.WordAtCaretRange;
  2665. if Range.StartPos <> Range.EndPos then
  2666. FActiveMemo.SetSingleSelection(Range.EndPos, Range.StartPos);
  2667. end;
  2668. FActiveMemo.SelectAllOccurrences([sfoMatchCase]);
  2669. end;
  2670. procedure TMainForm.ESelectNextOccurrenceClick(Sender: TObject);
  2671. begin
  2672. { Might be called even if ESelectNextOccurrence.Enabled would be False in EMenuClick }
  2673. FActiveMemo.SelectNextOccurrence([sfoMatchCase]);
  2674. end;
  2675. procedure TMainForm.EToggleLinesCommentClick(Sender: TObject);
  2676. begin
  2677. ToggleLinesComment(FActiveMemo);
  2678. end;
  2679. procedure TMainForm.EBraceMatchClick(Sender: TObject);
  2680. begin
  2681. FActiveMemo.BraceMatch;
  2682. end;
  2683. procedure TMainForm.ESelectAllFindMatchesClick(Sender: TObject);
  2684. begin
  2685. { Might be called even if ESelectAllFindMatches.Enabled would be False in EMenuClick }
  2686. if FLastFindText <> '' then
  2687. SelectAllFindMatches(FActiveMemo);
  2688. end;
  2689. procedure TMainForm.VMenuClick(Sender: TObject);
  2690. begin
  2691. UpdateViewMenu(Sender as TMenuItem);
  2692. end;
  2693. procedure TMainForm.VNextTabClick(Sender: TObject);
  2694. var
  2695. NewTabIndex: Integer;
  2696. begin
  2697. NewTabIndex := MemosTabSet.TabIndex+1;
  2698. if NewTabIndex >= MemosTabSet.Tabs.Count then
  2699. NewTabIndex := 0;
  2700. MemosTabSet.TabIndex := NewTabIndex;
  2701. end;
  2702. procedure TMainForm.VPreviousTabClick(Sender: TObject);
  2703. var
  2704. NewTabIndex: Integer;
  2705. begin
  2706. NewTabIndex := MemosTabSet.TabIndex-1;
  2707. if NewTabIndex < 0 then
  2708. NewTabIndex := MemosTabSet.Tabs.Count-1;
  2709. MemosTabSet.TabIndex := NewTabIndex;
  2710. end;
  2711. procedure TMainForm.CloseTab(const TabIndex: Integer);
  2712. begin
  2713. var Memo := TabIndexToMemo(TabIndex, MemosTabSet.Tabs.Count-1);
  2714. var MemoWasActiveMemo := Memo = FActiveMemo;
  2715. MemosTabSet.Tabs.Delete(TabIndex); { This will not change MemosTabset.TabIndex }
  2716. MemosTabSet.Hints.Delete(TabIndex);
  2717. MemosTabSet.CloseButtons.Delete(TabIndex);
  2718. FHiddenFiles.Add((Memo as TIDEScintFileEdit).Filename);
  2719. InvalidateStatusPanel(spHiddenFilesCount);
  2720. BuildAndSaveKnownIncludedAndHiddenFiles;
  2721. { Because MemosTabSet.Tabs and FHiddenFiles have both been updated now,
  2722. hereafter setting TabIndex will not select the memo we're closing
  2723. even if it's not hidden yet because TabIndexToMemo as called by
  2724. MemosTabSetClick will skip it }
  2725. if MemoWasActiveMemo then begin
  2726. if MemosTabSet.Tabs.Count > 1 then begin
  2727. { Select next tab, except when we're already at the end. Avoiding flicker by
  2728. doing this before hiding old active memo. We do this in a dirty way by
  2729. clicking two tabs while making sure TabSetClick doesn't see the first
  2730. 'fake' one. }
  2731. FIgnoreTabSetClick := True;
  2732. try
  2733. VNextTabClick(Self);
  2734. finally
  2735. FIgnoreTabSetClick := False;
  2736. end;
  2737. VPreviousTabClick(Self);
  2738. end else
  2739. MemosTabSet.TabIndex := 0;
  2740. Memo.CancelAutoCompleteAndCallTip;
  2741. Memo.Visible := False;
  2742. end else if TabIndex < MemosTabset.TabIndex then
  2743. MemosTabSet.TabIndex := MemosTabset.TabIndex-1; { Reselect old selected tab }
  2744. end;
  2745. procedure TMainForm.VCloseCurrentTabClick(Sender: TObject);
  2746. begin
  2747. CloseTab(MemosTabSet.TabIndex);
  2748. end;
  2749. procedure TMainForm.ReopenTabOrTabs(const HiddenFileIndex: Integer;
  2750. const Activate: Boolean);
  2751. begin
  2752. var ReopenFilename: String;
  2753. if HiddenFileIndex >= 0 then begin
  2754. ReopenFilename := FHiddenFiles[HiddenFileIndex];
  2755. FHiddenFiles.Delete(HiddenFileIndex);
  2756. end else begin
  2757. ReopenFilename := FHiddenFiles[0];
  2758. FHiddenFiles.Clear;
  2759. end;
  2760. InvalidateStatusPanel(spHiddenFilesCount);
  2761. UpdatePreprocMemos;
  2762. BuildAndSaveKnownIncludedAndHiddenFiles;
  2763. { Activate the memo if requested }
  2764. if Activate then begin
  2765. for var Memo in FFileMemos do begin
  2766. if Memo.Used and (PathCompare(Memo.Filename, ReopenFilename) = 0) then begin
  2767. MemosTabSet.TabIndex := MemoToTabIndex(memo);
  2768. Break;
  2769. end;
  2770. end
  2771. end;
  2772. end;
  2773. procedure TMainForm.ReopenTabClick(Sender: TObject);
  2774. begin
  2775. ReopenTabOrTabs(Integer((Sender as TMenuItem).Tag), True);
  2776. end;
  2777. procedure TMainForm.VReopenTabsClick(Sender: TObject);
  2778. begin
  2779. ReopenTabOrTabs(-1, True);
  2780. end;
  2781. procedure TMainForm.VZoomInClick(Sender: TObject);
  2782. begin
  2783. FActiveMemo.ZoomIn; { MemoZoom will zoom the other memos }
  2784. end;
  2785. procedure TMainForm.VZoomOutClick(Sender: TObject);
  2786. begin
  2787. FActiveMemo.ZoomOut;
  2788. end;
  2789. procedure TMainForm.VZoomResetClick(Sender: TObject);
  2790. begin
  2791. FActiveMemo.Zoom := 0;
  2792. end;
  2793. procedure TMainForm.VToolbarClick(Sender: TObject);
  2794. begin
  2795. ToolbarPanel.Visible := not ToolbarPanel.Visible;
  2796. end;
  2797. procedure TMainForm.VStatusBarClick(Sender: TObject);
  2798. begin
  2799. StatusBar.Visible := not StatusBar.Visible;
  2800. end;
  2801. procedure TMainForm.VWordWrapClick(Sender: TObject);
  2802. begin
  2803. FOptions.WordWrap := not FOptions.WordWrap;
  2804. SyncEditorOptions;
  2805. var Ini := TConfigIniFile.Create;
  2806. try
  2807. Ini.WriteBool('Options', 'WordWrap', FOptions.WordWrap);
  2808. finally
  2809. Ini.Free;
  2810. end;
  2811. end;
  2812. procedure TMainForm.SetStatusPanelVisible(const AVisible: Boolean);
  2813. var
  2814. CaretWasInView: Boolean;
  2815. begin
  2816. if StatusPanel.Visible <> AVisible then begin
  2817. CaretWasInView := FActiveMemo.IsPositionInViewVertically(FActiveMemo.CaretPosition);
  2818. if AVisible then begin
  2819. { Ensure the status panel height isn't out of range before showing }
  2820. UpdateStatusPanelHeight(StatusPanel.Height);
  2821. SplitPanel.Top := ClientHeight;
  2822. StatusPanel.Top := ClientHeight;
  2823. end
  2824. else begin
  2825. if StatusPanel.ContainsControl(ActiveControl) then
  2826. ActiveControl := FActiveMemo;
  2827. end;
  2828. SplitPanel.Visible := AVisible;
  2829. StatusPanel.Visible := AVisible;
  2830. if AVisible and CaretWasInView then begin
  2831. { If the caret was in view, make sure it still is }
  2832. FActiveMemo.ScrollCaretIntoView;
  2833. end;
  2834. end;
  2835. end;
  2836. procedure TMainForm.VHideClick(Sender: TObject);
  2837. begin
  2838. SetStatusPanelVisible(False);
  2839. end;
  2840. procedure TMainForm.VCompilerOutputClick(Sender: TObject);
  2841. begin
  2842. OutputTabSet.TabIndex := tiCompilerOutput;
  2843. SetStatusPanelVisible(True);
  2844. end;
  2845. procedure TMainForm.VDebugOutputClick(Sender: TObject);
  2846. begin
  2847. OutputTabSet.TabIndex := tiDebugOutput;
  2848. SetStatusPanelVisible(True);
  2849. end;
  2850. procedure TMainForm.VDebugCallStackClick(Sender: TObject);
  2851. begin
  2852. OutputTabSet.TabIndex := tiDebugCallStack;
  2853. SetStatusPanelVisible(True);
  2854. end;
  2855. procedure TMainForm.VFindResultsClick(Sender: TObject);
  2856. begin
  2857. OutputTabSet.TabIndex := tiFindResults;
  2858. SetStatusPanelVisible(True);
  2859. end;
  2860. procedure TMainForm.BMenuClick(Sender: TObject);
  2861. begin
  2862. UpdateBuildMenu(Sender as TMenuItem);
  2863. end;
  2864. procedure TMainForm.BCompileClick(Sender: TObject);
  2865. begin
  2866. CompileFile('', False);
  2867. end;
  2868. procedure TMainForm.BStopCompileClick(Sender: TObject);
  2869. begin
  2870. SetAppTaskbarProgressState(tpsPaused);
  2871. try
  2872. if MsgBox('Are you sure you want to abort the compile?', SCompilerFormCaption,
  2873. mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
  2874. FCompileWantAbort := True;
  2875. finally
  2876. SetAppTaskbarProgressState(tpsNormal);
  2877. end;
  2878. end;
  2879. procedure TMainForm.BLowPriorityClick(Sender: TObject);
  2880. begin
  2881. FOptions.LowPriorityDuringCompile := not FOptions.LowPriorityDuringCompile;
  2882. { If a compile is already in progress, change the priority now }
  2883. if FCompiling then
  2884. SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
  2885. end;
  2886. procedure TMainForm.BOpenOutputFolderClick(Sender: TObject);
  2887. begin
  2888. LaunchFileOrURL(AddBackslash(GetSystemWinDir) + 'explorer.exe',
  2889. Format('/select,"%s"', [FCompiledExe]));
  2890. end;
  2891. procedure TMainForm.HMenuClick(Sender: TObject);
  2892. begin
  2893. UpdateHelpMenu(Sender as TMenuItem);
  2894. end;
  2895. procedure TMainForm.HPurchaseClick(Sender: TObject);
  2896. begin
  2897. if IsLicensed then
  2898. if MsgBox('Do you want to copy your current license key to the clipboard before opening our order page? You will need it to be able to renew it.',
  2899. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  2900. ClipBoard.AsText := GetChunkedLicenseKey;
  2901. LaunchFileOrURL('https://jrsoftware.org/isorder.php');
  2902. end;
  2903. procedure TMainForm.HRegisterClick(Sender: TObject);
  2904. begin
  2905. const LicenseKeyForm = TLicenseKeyForm.Create(Application);
  2906. try
  2907. if LicenseKeyForm.ShowModal = mrOk then begin
  2908. WriteLicense;
  2909. UpdateCaption;
  2910. MsgBox('New commercial license key has been registered:' + SNewLine2 +
  2911. GetLicenseDescription('', SNewLine2) + SNewLine2 +
  2912. 'Thanks for your support!', SCompilerFormCaption, mbInformation, MB_OK);
  2913. end;
  2914. finally
  2915. LicenseKeyForm.Free;
  2916. end;
  2917. end;
  2918. procedure TMainForm.HUnregisterClick(Sender: TObject);
  2919. begin
  2920. if MsgBox('Are you sure you want to remove your commercial license key and revert to non-commercial use only?',
  2921. SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then begin
  2922. RemoveLicense;
  2923. UpdateCaption;
  2924. const Ini = TConfigIniFile.Create;
  2925. try
  2926. const AskAgainDateAsInt = FormatDateTime('yyyymmdd', IncDay(IncMonth(Date, 6), -1)).ToInteger;
  2927. Ini.WriteInteger('UpdatePanel', 'Purchase', AskAgainDateAsInt);
  2928. finally
  2929. Ini.Free;
  2930. end;
  2931. MsgBox('Commercial license key has been removed.', SCompilerFormCaption, mbInformation, MB_OK);
  2932. end;
  2933. end;
  2934. procedure TMainForm.HDonateClick(Sender: TObject);
  2935. begin
  2936. OpenDonateSite;
  2937. end;
  2938. procedure TMainForm.HShortcutsDocClick(Sender: TObject);
  2939. begin
  2940. if Assigned(HtmlHelp) then
  2941. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, DWORD_PTR(PChar('topic_compformshortcuts.htm')));
  2942. end;
  2943. procedure TMainForm.HRegExDocClick(Sender: TObject);
  2944. begin
  2945. if Assigned(HtmlHelp) then
  2946. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, DWORD_PTR(PChar('topic_compformregex.htm')));
  2947. end;
  2948. procedure TMainForm.HDocClick(Sender: TObject);
  2949. begin
  2950. if Assigned(HtmlHelp) then
  2951. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, 0);
  2952. end;
  2953. procedure TMainForm.HExamplesClick(Sender: TObject);
  2954. begin
  2955. LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'Examples');
  2956. end;
  2957. procedure TMainForm.HFaqClick(Sender: TObject);
  2958. begin
  2959. LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'isfaq.url');
  2960. end;
  2961. procedure TMainForm.HWhatsNewClick(Sender: TObject);
  2962. begin
  2963. LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + {$IFDEF DEBUG} '..\..\' + {$ENDIF} 'whatsnew.htm');
  2964. end;
  2965. procedure TMainForm.HWebsiteClick(Sender: TObject);
  2966. begin
  2967. LaunchFileOrURL('https://jrsoftware.org/isinfo.php');
  2968. end;
  2969. procedure TMainForm.HMailingListClick(Sender: TObject);
  2970. begin
  2971. OpenMailingListSite;
  2972. end;
  2973. procedure TMainForm.HISPPDocClick(Sender: TObject);
  2974. begin
  2975. if Assigned(HtmlHelp) then
  2976. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, DWORD_PTR(PChar('topic_isppoverview.htm')));
  2977. end;
  2978. procedure TMainForm.HAboutClick(Sender: TObject);
  2979. var
  2980. S: String;
  2981. begin
  2982. { Removing the About box or modifying any existing text inside it is a
  2983. violation of the Inno Setup license agreement; see LICENSE.TXT.
  2984. However, adding additional lines to the About box is permitted, as long as
  2985. they are placed below the original copyright notice. }
  2986. S := FCompilerVersion.Title + ' Compiler version ' +
  2987. String(FCompilerVersion.Version) + SNewLine;
  2988. if FCompilerVersion.Title <> 'Inno Setup' then
  2989. S := S + (SNewLine + 'Based on Inno Setup' + SNewLine);
  2990. S := S + ('Copyright (C) 1997-2026 Jordan Russell' + SNewLine +
  2991. 'Portions Copyright (C) 2000-2026 Martijn Laan' + SNewLine +
  2992. 'All rights reserved.' + SNewLine2 +
  2993. 'Inno Setup home page:' + SNewLine +
  2994. 'https://www.innosetup.com/' + SNewLine2 +
  2995. 'Refer to LICENSE.TXT for conditions of distribution and use.');
  2996. S := S + SNewLine2 + GetLicenseDescription('Registered commercial license:' + SNewLine, SNewLine);
  2997. MsgBox(S, 'About ' + FCompilerVersion.Title, mbInformation, MB_OK);
  2998. end;
  2999. procedure TMainForm.WMStartCommandLineCompile(var Message: TMessage);
  3000. var
  3001. Code: Integer;
  3002. begin
  3003. UpdateStatusPanelHeight(ClientHeight);
  3004. Code := 0;
  3005. try
  3006. try
  3007. CompileFile(CommandLineFilename, True);
  3008. except
  3009. Code := 2;
  3010. Application.HandleException(Self);
  3011. end;
  3012. finally
  3013. System.ExitCode := Code;
  3014. Halt;
  3015. end;
  3016. end;
  3017. procedure TMainForm.WMStartCommandLineWizard(var Message: TMessage);
  3018. var
  3019. Code: Integer;
  3020. begin
  3021. Code := 0;
  3022. try
  3023. try
  3024. NewMainFileUsingWizard;
  3025. except
  3026. Code := 2;
  3027. Application.HandleException(Self);
  3028. end;
  3029. finally
  3030. System.ExitCode := Code;
  3031. Halt;
  3032. end;
  3033. end;
  3034. procedure TMainForm.WMStartNormally(var Message: TMessage);
  3035. procedure ShowStartupForm;
  3036. var
  3037. StartupForm: TStartupForm;
  3038. Ini: TConfigIniFile;
  3039. begin
  3040. ReadMRUMainFilesList;
  3041. StartupForm := TStartupForm.Create(Application);
  3042. try
  3043. StartupForm.MRUFilesList := FMRUMainFilesList;
  3044. StartupForm.StartupCheck.Checked := not FOptions.ShowStartupForm;
  3045. if StartupForm.ShowModal = mrOK then begin
  3046. if FOptions.ShowStartupForm <> not StartupForm.StartupCheck.Checked then begin
  3047. FOptions.ShowStartupForm := not StartupForm.StartupCheck.Checked;
  3048. Ini := TConfigIniFile.Create;
  3049. try
  3050. Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
  3051. finally
  3052. Ini.Free;
  3053. end;
  3054. end;
  3055. case StartupForm.Result of
  3056. srEmpty:
  3057. FNewMainFileClick(Self);
  3058. srWizard:
  3059. FNewMainFileUserWizardClick(Self);
  3060. srOpenFile:
  3061. if ConfirmCloseFile(True) then
  3062. OpenMRUMainFile(StartupForm.ResultMainFileName);
  3063. srOpenDialog:
  3064. ShowOpenMainFileDialog(False);
  3065. srOpenDialogExamples:
  3066. ShowOpenMainFileDialog(True);
  3067. end;
  3068. end;
  3069. finally
  3070. StartupForm.Free;
  3071. end;
  3072. end;
  3073. begin
  3074. if CommandLineFilename = '' then begin
  3075. if FOptions.ShowStartupForm then
  3076. ShowStartupForm;
  3077. end else
  3078. OpenFile(FMainMemo, CommandLineFilename, False);
  3079. end;
  3080. procedure TMainForm.WMSysColorChange(var Message: TMessage);
  3081. begin
  3082. inherited;
  3083. for var Memo in FMemos do
  3084. Memo.SysColorChange(Message);
  3085. end;
  3086. procedure TMainForm.MemosTabSetPopupMenuClick(Sender: TObject);
  3087. begin
  3088. UpdateMemosTabSetMenu(Sender as TMenuItem);
  3089. end;
  3090. procedure TMainForm.MemosTabSetClick(Sender: TObject);
  3091. begin
  3092. if FIgnoreTabSetClick then
  3093. Exit;
  3094. var NewActiveMemo := TabIndexToMemo(MemosTabSet.TabIndex, MemosTabSet.Tabs.Count-1);
  3095. if NewActiveMemo <> FActiveMemo then begin
  3096. { Avoiding flicker by showing new before hiding old }
  3097. NewActiveMemo.Visible := True;
  3098. var OldActiveMemo := FActiveMemo;
  3099. FActiveMemo := NewActiveMemo;
  3100. ActiveControl := NewActiveMemo;
  3101. OldActiveMemo.CancelAutoCompleteAndCallTip;
  3102. OldActiveMemo.Visible := False;
  3103. UpdateSaveMenuItemAndButton;
  3104. UpdateRunMenu;
  3105. UpdateCaretPosPanelAndBackNavStack;
  3106. UpdateEditModeStatusPanel;
  3107. UpdateModifiedStatusPanel;
  3108. end;
  3109. end;
  3110. procedure TMainForm.MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
  3111. begin
  3112. CloseTab(Index);
  3113. end;
  3114. procedure TMainForm.EFindClick(Sender: TObject);
  3115. begin
  3116. ShowFindDialog(True);
  3117. end;
  3118. procedure TMainForm.EFindInFilesClick(Sender: TObject);
  3119. begin
  3120. ShowFindInFilesDialog;
  3121. end;
  3122. procedure TMainForm.EFindNextOrPreviousClick(Sender: TObject);
  3123. begin
  3124. DoFindNext(Sender = EFindNext);
  3125. end;
  3126. procedure TMainForm.FindDialogFind(Sender: TObject);
  3127. begin
  3128. { This event handler is shared between FindDialog & ReplaceDialog }
  3129. DoFindOrReplaceDialogFind(Sender as TFindDialog);
  3130. end;
  3131. procedure TMainForm.FindInFilesDialogFind(Sender: TObject);
  3132. begin
  3133. DoFindInFilesDialogFind;
  3134. end;
  3135. procedure TMainForm.EReplaceClick(Sender: TObject);
  3136. begin
  3137. ShowReplaceDialog;
  3138. end;
  3139. procedure TMainForm.ReplaceDialogReplace(Sender: TObject);
  3140. begin
  3141. DoReplaceDialogReplace;
  3142. end;
  3143. procedure TMainForm.EFindRegExClick(Sender: TObject);
  3144. begin
  3145. { If EFindRegEx uses Alt+R as the shortcut just like VSCode then also handle it like VSCode:
  3146. when the memo does not have the focus open the Run menu (also Alt+R) instead }
  3147. if not FActiveMemo.Focused and (EFindRegEx.ShortCut = ShortCut(Ord('R'), [ssAlt])) then
  3148. SendMessage(Handle, WM_SYSCOMMAND, SC_KEYMENU, Ord('r'))
  3149. else begin
  3150. FOptions.FindRegEx := not FOptions.FindRegEx;
  3151. UpdateFindRegExUI;
  3152. var Ini := TConfigIniFile.Create;
  3153. try
  3154. Ini.WriteBool('Options', 'FindRegEx', FOptions.FindRegEx);
  3155. finally
  3156. Ini.Free;
  3157. end;
  3158. end;
  3159. end;
  3160. procedure TMainForm.EFoldOrUnfoldLineClick(Sender: TObject);
  3161. begin
  3162. FActiveMemo.FoldLine(FActiveMemo.CaretLine, Sender = EFoldLine);
  3163. end;
  3164. procedure TMainForm.UpdateStatusPanelHeight(H: Integer);
  3165. var
  3166. MinHeight, MaxHeight: Integer;
  3167. begin
  3168. MinHeight := (3 * DebugOutputList.ItemHeight + ToCurrentPPI(4)) + OutputTabSet.Height;
  3169. MaxHeight := BodyPanel.ClientHeight - ToCurrentPPI(48) - SplitPanel.Height;
  3170. if H > MaxHeight then H := MaxHeight;
  3171. if H < MinHeight then H := MinHeight;
  3172. StatusPanel.Height := H;
  3173. end;
  3174. procedure TMainForm.UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
  3175. procedure FindTextAndAddRanges(const AMemo: TIDEScintEdit;
  3176. const TextToFind: TScintRawString; const Options: TScintFindOptions;
  3177. const Selections, IndicatorRanges: TScintRangeList);
  3178. begin
  3179. if TScintEdit.RawStringIsBlank(TextToFind) then
  3180. Exit;
  3181. var StartPos := 0;
  3182. var EndPos := AMemo.RawTextLength;
  3183. var FoundRange: TScintRange;
  3184. while (StartPos < EndPos) and
  3185. AMemo.FindRawText(StartPos, EndPos, TextToFind, Options, FoundRange) do begin
  3186. StartPos := FoundRange.EndPos;
  3187. { Don't add indicators on lines which have a line marker }
  3188. var Line := AMemo.GetLineFromPosition(FoundRange.StartPos);
  3189. var Markers := AMemo.GetMarkers(Line);
  3190. if Markers * [mlmError, mlmBreakpointBad, mlmStep] <> [] then
  3191. Continue;
  3192. { Add indicator while making sure it does not overlap any regular selection
  3193. styling for either the main selection or any additional selection. Does
  3194. not account for an indicator overlapping more than 1 selection. }
  3195. var OverlappingSelection: TScintRange;
  3196. if Selections.Overlaps(FoundRange, OverlappingSelection) then begin
  3197. if FoundRange.StartPos < OverlappingSelection.StartPos then
  3198. IndicatorRanges.Add(TScintRange.Create(FoundRange.StartPos, OverlappingSelection.StartPos));
  3199. if FoundRange.EndPos > OverlappingSelection.EndPos then
  3200. IndicatorRanges.Add(TScintRange.Create(OverlappingSelection.EndPos, FoundRange.EndPos));
  3201. end else
  3202. IndicatorRanges.Add(FoundRange);
  3203. end;
  3204. end;
  3205. function HighlightAtCursorAllowed(const Word: TScintRawString): Boolean;
  3206. begin
  3207. const Section = FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]);
  3208. Result := FMemosStyler.HighlightAtCursorAllowed(Section, FActiveMemo.ConvertRawStringToString(Word));
  3209. end;
  3210. begin
  3211. { Add occurrence indicators for the word at cursor if there's any and the
  3212. main selection is within this word. On top of those add occurrence indicators
  3213. for the main selected text if there's any. Don't do anything if the main
  3214. selection is not single line. All of these things are just like VSCode. }
  3215. var MainSelection: TScintRange;
  3216. var MainSelNotEmpty := AMemo.SelNotEmpty(MainSelection);
  3217. var MainSelSingleLine := AMemo.GetLineFromPosition(MainSelection.StartPos) =
  3218. AMemo.GetLineFromPosition(MainSelection.EndPos);
  3219. var IndicatorRanges: TScintRangeList := nil;
  3220. var Selections: TScintRangeList := nil;
  3221. try
  3222. IndicatorRanges := TScintRangeList.Create;
  3223. Selections := TScintRangeList.Create;
  3224. if FOptions.HighlightWordAtCursorOccurrences and (AMemo.CaretVirtualSpace = 0) and MainSelSingleLine then begin
  3225. var Word := AMemo.WordAtCaretRange;
  3226. if (Word.StartPos <> Word.EndPos) and MainSelection.Within(Word) then begin
  3227. var TextToIndicate := AMemo.GetRawTextRange(Word.StartPos, Word.EndPos);
  3228. if HighlightAtCursorAllowed(TextToIndicate) then begin
  3229. AMemo.GetSelections(Selections); { Gets any additional selections as well }
  3230. FindTextAndAddRanges(AMemo, TextToIndicate, [sfoMatchCase, sfoWholeWord], Selections, IndicatorRanges);
  3231. end;
  3232. end;
  3233. end;
  3234. AMemo.UpdateIndicators(IndicatorRanges, minWordAtCursorOccurrence);
  3235. IndicatorRanges.Clear;
  3236. if FOptions.HighlightSelTextOccurrences and MainSelNotEmpty and MainSelSingleLine then begin
  3237. var TextToIndicate := AMemo.RawMainSelText;
  3238. if Selections.Count = 0 then { If 0 then we didn't already call GetSelections above}
  3239. AMemo.GetSelections(Selections);
  3240. FindTextAndAddRanges(AMemo, TextToIndicate, [], Selections, IndicatorRanges);
  3241. end;
  3242. AMemo.UpdateIndicators(IndicatorRanges, minSelTextOccurrence);
  3243. finally
  3244. Selections.Free;
  3245. IndicatorRanges.Free;
  3246. end;
  3247. end;
  3248. procedure TMainForm.UpdateImages;
  3249. { Should be called at startup and after DPI changes }
  3250. begin
  3251. var WH := MulDiv(16, CurrentPPI, 96);
  3252. var Images := ImagesModule.ToolbarImageCollection[FTheme.Dark];
  3253. var Image := Images.GetSourceImage(Images.GetIndexByName('heart-filled'), WH, WH);
  3254. UpdatePanelDonateBitBtn.Graphic := Image;
  3255. end;
  3256. procedure TMainForm.UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  3257. { Should be called at startup and after DPI changes }
  3258. begin
  3259. CompilerOutputList.Canvas.Font.Assign(CompilerOutputList.Font);
  3260. CompilerOutputList.ItemHeight := CompilerOutputList.Canvas.TextHeight('0') + 1;
  3261. DebugOutputList.Canvas.Font.Assign(DebugOutputList.Font);
  3262. FDebugLogListTimestampsWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000] ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator]));
  3263. DebugOutputList.ItemHeight := DebugOutputList.Canvas.TextHeight('0') + 1;
  3264. DebugCallStackList.Canvas.Font.Assign(DebugCallStackList.Font);
  3265. DebugCallStackList.ItemHeight := DebugCallStackList.Canvas.TextHeight('0') + 1;
  3266. FindResultsList.Canvas.Font.Assign(FindResultsList.Font);
  3267. FindResultsList.ItemHeight := FindResultsList.Canvas.TextHeight('0') + 1;
  3268. end;
  3269. type
  3270. TBitmapWithBits = class
  3271. Handle: HBITMAP;
  3272. pvBits: Pointer;
  3273. destructor Destroy; override;
  3274. end;
  3275. destructor TBitmapWithBits.Destroy;
  3276. begin
  3277. if Handle <> 0 then
  3278. DeleteObject(Handle);
  3279. inherited;
  3280. end;
  3281. procedure TMainForm.UpdateMarginsAndAutoCompleteIcons;
  3282. { Should be called at startup and after theme and DPI changes }
  3283. type
  3284. TMarkerOrACBitmaps = TObjectDictionary<Integer, TBitmapWithBits>;
  3285. procedure SwapRedBlue(const pvBits: PByte; Width, Height: Integer);
  3286. begin
  3287. var pvPixel := pvBits;
  3288. var pvMax := pvBits + 4*Width*Height;
  3289. while pvPixel < pvMax do begin
  3290. var Tmp := PByte(pvPixel)^;
  3291. PByte(pvPixel)^ := PByte(pvPixel + 2)^;
  3292. PByte(pvPixel + 2)^ := Tmp;
  3293. Inc(pvPixel, 4);
  3294. end;
  3295. end;
  3296. procedure AddMarkerOrACBitmap(const MarkerOrACBitmaps: TMarkerOrACBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
  3297. const MarkerNumberOrACType: Integer; const BkBrush: TBrush; const ImageList: TVirtualImageList; const ImageName: String);
  3298. begin
  3299. { Prepare a bitmap and select it }
  3300. var pvBits: Pointer;
  3301. var Bitmap := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0);
  3302. var OldBitmap := SelectObject(DC, Bitmap);
  3303. { Fill the entire bitmap to avoid any alpha so we don't have to worry about
  3304. whether will be premultiplied or not (it was in tests) when Scintilla wants
  3305. it without premultiplication }
  3306. var Width := BitmapInfo.bmiHeader.biWidth;
  3307. var Height := Abs(BitmapInfo.bmiHeader.biHeight);
  3308. var Rect := TRect.Create(0, 0, Width, Height);
  3309. FillRect(DC, Rect, BkBrush.Handle);
  3310. { Draw the image - the result will be in pvBits }
  3311. if ImageList_Draw(ImageList.Handle, ImageList.GetIndexByName(ImageName), DC, 0, 0, ILD_TRANSPARENT) then begin
  3312. SwapRedBlue(pvBits, Width, Height); { Change pvBits from BGRA to RGBA like Scintilla wants }
  3313. var Bitmap2 := TBitmapWithBits.Create;
  3314. Bitmap2.Handle := Bitmap;
  3315. Bitmap2.pvBits := pvBits;
  3316. MarkerOrACBitmaps.Add(MarkerNumberOrACType, Bitmap2);
  3317. end else begin
  3318. SelectObject(DC, OldBitmap);
  3319. DeleteObject(Bitmap);
  3320. end;
  3321. end;
  3322. type
  3323. TMarkerNumberOrACType = TPair<Integer, String>;
  3324. function NNT(const MarkerNumberOrACType: Integer; const Name: String): TMarkerNumberOrACType;
  3325. begin
  3326. Result := TMarkerNumberOrACType.Create(MarkerNumberOrACType, Name); { This is a record so no need to free }
  3327. end;
  3328. begin
  3329. var ImageList := ThemedMarkersAndACVirtualImageList;
  3330. var DC := CreateCompatibleDC(0);
  3331. if DC <> 0 then begin
  3332. try
  3333. var MarkerBitmaps: TMarkerOrACBitmaps := nil;
  3334. var MarkerBkBrush: TBrush := nil;
  3335. var AutoCompleteBitmaps: TMarkerOrACBitmaps := nil;
  3336. var AutoCompleteBkBrush: TBrush := nil;
  3337. try
  3338. var BitmapInfo := CreateBitmapInfo(ImageList.Width, -ImageList.Height, 32); { This is a record so no need to free }
  3339. MarkerBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
  3340. MarkerBkBrush := TBrush.Create;
  3341. MarkerBkBrush.Color := FTheme.Colors[tcMarginBack];
  3342. var NamedMarkers := [
  3343. NNT(mmiHasEntry, 'markers\debug-stop-filled'),
  3344. NNT(mmiEntryProcessed, 'markers\debug-stop-filled_2'),
  3345. NNT(mmiBreakpoint, 'markers\debug-breakpoint-filled'),
  3346. NNT(mmiBreakpointBad, 'markers\debug-breakpoint-filled-cancel-2'),
  3347. NNT(mmiBreakpointGood, 'markers\debug-breakpoint-filled-ok-2'),
  3348. NNT(mmiStep, 'markers\symbol-arrow-right'),
  3349. NNT(mmiBreakpointStep, 'markers\debug-breakpoint-filled-ok2-symbol-arrow-right'),
  3350. NNT(SC_MARKNUM_FOLDER, 'markers\symbol-add'),
  3351. NNT(SC_MARKNUM_FOLDEROPEN, 'markers\symbol-remove')];
  3352. for var NamedMarker in NamedMarkers do
  3353. AddMarkerOrAcBitmap(MarkerBitmaps, DC, BitmapInfo, NamedMarker.Key, MarkerBkBrush, ImageList, NamedMarker.Value);
  3354. AutoCompleteBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
  3355. AutoCompleteBkBrush := TBrush.Create;
  3356. AutoCompleteBkBrush.Color := FTheme.Colors[tcIntelliBack];
  3357. var NamedTypes := [
  3358. NNT(awtSection, 'ac\structure-filled'),
  3359. NNT(awtParameter, 'ac\xml-filled'),
  3360. NNT(awtDirective, 'ac\xml-filled'),
  3361. NNT(awtFlagOrSetupDirectiveValue, 'ac\values'),
  3362. NNT(awtPreprocessorDirective, 'ac\symbol-hashtag'),
  3363. NNT(awtConstant, 'ac\constant-filled_2'),
  3364. NNT(awtScriptFunction, 'ac\method-filled'),
  3365. NNT(awtScriptType, 'ac\types'),
  3366. NNT(awtScriptVariable, 'ac\variables'),
  3367. NNT(awtScriptConstant, 'ac\constant-filled'),
  3368. NNT(awtScriptInterface, 'ac\interface-filled'),
  3369. NNT(awtScriptProperty, 'ac\properties-filled'),
  3370. NNT(awtScriptEvent, 'ac\event-filled'),
  3371. NNT(awtScriptKeyword, 'ac\list'),
  3372. NNT(awtScriptEnumValue, 'ac\constant-filled')];
  3373. for var NamedType in NamedTypes do
  3374. AddMarkerOrAcBitmap(AutoCompleteBitmaps, DC, BitmapInfo, NamedType.Key, AutoCompleteBkBrush, ImageList, NamedType.Value);
  3375. for var Memo in FMemos do begin
  3376. Memo.Call(SCI_RGBAIMAGESETWIDTH, ImageList.Width, 0);
  3377. Memo.Call(SCI_RGBAIMAGESETHEIGHT, ImageList.Height, 0);
  3378. for var MarkerBitmap in MarkerBitmaps do
  3379. Memo.Call(SCI_MARKERDEFINERGBAIMAGE, MarkerBitmap.Key, LPARAM(MarkerBitmap.Value.pvBits));
  3380. for var AutoCompleteBitmap in AutoCompleteBitmaps do
  3381. Memo.Call(SCI_REGISTERRGBAIMAGE, AutoCompleteBitmap.Key, LPARAM(AutoCompleteBitmap.Value.pvBits));
  3382. end;
  3383. finally
  3384. AutoCompleteBkBrush.Free;
  3385. AutoCompleteBitmaps.Free;
  3386. MarkerBkBrush.Free;
  3387. MarkerBitmaps.Free;
  3388. end;
  3389. finally
  3390. DeleteDC(DC);
  3391. end;
  3392. end;
  3393. end;
  3394. procedure TMainForm.UpdateMarginsAndSquigglyAndCaretWidths;
  3395. { Update the width of our two margins. Note: the width of the line numbers
  3396. margin is fully handled by TScintEdit. Should be called at startup and after
  3397. DPI change. }
  3398. begin
  3399. var IconMarkersWidth := ToCurrentPPI(18); { 3 pixel margin on both sides of the icon }
  3400. 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" }
  3401. var FolderMarkersWidth := ToCurrentPPI(14); { 1 pixel margin on boths side of the icon }
  3402. var LeftBlankMarginWidth := ToCurrentPPI(2); { 2 pixel margin between gutter and the main text }
  3403. var SquigglyWidth := ToCurrentPPI(100); { 100 = 1 pixel }
  3404. var CaretWidth := ToCurrentPPI(2);
  3405. var WhiteSpaceSize := CaretWidth;
  3406. for var Memo in FMemos do
  3407. Memo.UpdateWidthsAndSizes(IconMarkersWidth, BaseChangeHistoryWidth, FolderMarkersWidth,
  3408. LeftBlankMarginWidth, 0, SquigglyWidth, CaretWidth, WhiteSpaceSize);
  3409. end;
  3410. procedure TMainForm.SplitPanelMouseMove(Sender: TObject;
  3411. Shift: TShiftState; X, Y: Integer);
  3412. begin
  3413. if (ssLeft in Shift) and StatusPanel.Visible then begin
  3414. UpdateStatusPanelHeight(BodyPanel.ClientToScreen(Point(0, 0)).Y -
  3415. SplitPanel.ClientToScreen(Point(0, Y)).Y +
  3416. BodyPanel.ClientHeight - (SplitPanel.Height div 2));
  3417. end;
  3418. end;
  3419. procedure TMainForm.SimpleMenuClick(Sender: TObject);
  3420. begin
  3421. UpdateSimpleMenu(Sender as TMenuItem);
  3422. end;
  3423. procedure TMainForm.TMenuClick(Sender: TObject);
  3424. begin
  3425. UpdateToolsMenu(Sender as TMenuItem);
  3426. end;
  3427. procedure TMainForm.TAddRemoveProgramsClick(Sender: TObject);
  3428. begin
  3429. StartAddRemovePrograms;
  3430. end;
  3431. procedure TMainForm.TGenerateGUIDClick(Sender: TObject);
  3432. begin
  3433. InsertGeneratedGuid(FActiveMemo);
  3434. end;
  3435. procedure TMainForm.TMsgBoxDesignerClick(Sender: TObject);
  3436. begin
  3437. ShowMsgBoxDesignerForm(FActiveMemo);
  3438. end;
  3439. procedure TMainForm.TRegistryDesignerClick(Sender: TObject);
  3440. begin
  3441. ShowRegistryDesignerForm(FActiveMemo);
  3442. end;
  3443. procedure TMainForm.TFilesDesignerClick(Sender: TObject);
  3444. begin
  3445. ShowFilesDesignerForm(FActiveMemo);
  3446. end;
  3447. procedure TMainForm.TSignToolsClick(Sender: TObject);
  3448. begin
  3449. ShowSignToolsForm;
  3450. end;
  3451. procedure TMainForm.TOptionsClick(Sender: TObject);
  3452. var
  3453. OptionsForm: TOptionsForm;
  3454. Ini: TConfigIniFile;
  3455. Memo: TIDEScintEdit;
  3456. begin
  3457. OptionsForm := TOptionsForm.Create(Application);
  3458. try
  3459. OptionsForm.StartupCheck.Checked := FOptions.ShowStartupForm;
  3460. OptionsForm.WizardCheck.Checked := FOptions.UseWizard;
  3461. OptionsForm.AutosaveCheck.Checked := FOptions.Autosave;
  3462. OptionsForm.AutoreloadCheck.Checked := FOptions.Autoreload;
  3463. OptionsForm.BackupCheck.Checked := FOptions.MakeBackups;
  3464. OptionsForm.FullPathCheck.Checked := FOptions.FullPathInTitleBar;
  3465. OptionsForm.UndoAfterSaveCheck.Checked := FOptions.UndoAfterSave;
  3466. OptionsForm.UndoAfterReloadCheck.Checked := FOptions.UndoAfterReload;
  3467. OptionsForm.PauseOnDebuggerExceptionsCheck.Checked := FOptions.PauseOnDebuggerExceptions;
  3468. OptionsForm.RunAsDifferentUserCheck.Checked := FOptions.RunAsDifferentUser;
  3469. OptionsForm.AutoAutoCompleteCheck.Checked := FOptions.AutoAutoComplete;
  3470. OptionsForm.UseSynHighCheck.Checked := FOptions.UseSyntaxHighlighting;
  3471. OptionsForm.ColorizeCompilerOutputCheck.Checked := FOptions.ColorizeCompilerOutput;
  3472. OptionsForm.UnderlineErrorsCheck.Checked := FOptions.UnderlineErrors;
  3473. OptionsForm.CursorPastEOLCheck.Checked := FOptions.CursorPastEOL;
  3474. OptionsForm.TabWidthEdit.Text := IntToStr(FOptions.TabWidth);
  3475. OptionsForm.UseTabCharacterCheck.Checked := FOptions.UseTabCharacter;
  3476. OptionsForm.ShowWhiteSpaceCheck.Checked := FOptions.ShowWhiteSpace;
  3477. OptionsForm.SmartHomeCheck.Checked := FOptions.SmartHome;
  3478. OptionsForm.UseFoldingCheck.Checked := FOptions.UseFolding;
  3479. OptionsForm.AutoIndentCheck.Checked := FOptions.AutoIndent;
  3480. OptionsForm.IndentationGuidesCheck.Checked := FOptions.IndentationGuides;
  3481. OptionsForm.GutterLineNumbersCheck.Checked := FOptions.GutterLineNumbers;
  3482. OptionsForm.ShowPreprocessorOutputCheck.Checked := FOptions.ShowPreprocessorOutput;
  3483. OptionsForm.OpenIncludedFilesCheck.Checked := FOptions.OpenIncludedFiles;
  3484. OptionsForm.AutoHideNewIncludedFilesCheck.Checked := FOptions.AutoHideNewIncludedFiles;
  3485. OptionsForm.KeyMappingComboBox.ItemIndex := Ord(FOptions.KeyMappingType);
  3486. OptionsForm.MemoKeyMappingComboBox.ItemIndex := Ord(FOptions.MemoKeyMappingType);
  3487. OptionsForm.ThemeComboBox.ItemIndex := Ord(FOptions.ThemeType);
  3488. OptionsForm.FontPanel.Font.Assign(FMainMemo.Font);
  3489. OptionsForm.FontPanel.ParentBackground := False;
  3490. OptionsForm.FontPanel.Color := FMainMemo.Color;
  3491. OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked := FOptions.HighlightWordAtCursorOccurrences;
  3492. OptionsForm.HighlightSelTextOccurrencesCheck.Checked := FOptions.HighlightSelTextOccurrences;
  3493. if OptionsForm.ShowModal <> mrOK then
  3494. Exit;
  3495. FOptions.ShowStartupForm := OptionsForm.StartupCheck.Checked;
  3496. FOptions.UseWizard := OptionsForm.WizardCheck.Checked;
  3497. FOptions.Autosave := OptionsForm.AutosaveCheck.Checked;
  3498. FOptions.Autoreload := OptionsForm.AutoreloadCheck.Checked;
  3499. FOptions.MakeBackups := OptionsForm.BackupCheck.Checked;
  3500. FOptions.FullPathInTitleBar := OptionsForm.FullPathCheck.Checked;
  3501. FOptions.UndoAfterSave := OptionsForm.UndoAfterSaveCheck.Checked;
  3502. FOptions.UndoAfterReload := OptionsForm.UndoAfterReloadCheck.Checked;
  3503. FOptions.PauseOnDebuggerExceptions := OptionsForm.PauseOnDebuggerExceptionsCheck.Checked;
  3504. FOptions.RunAsDifferentUser := OptionsForm.RunAsDifferentUserCheck.Checked;
  3505. FOptions.AutoAutoComplete := OptionsForm.AutoAutoCompleteCheck.Checked;
  3506. FOptions.UseSyntaxHighlighting := OptionsForm.UseSynHighCheck.Checked;
  3507. FOptions.ColorizeCompilerOutput := OptionsForm.ColorizeCompilerOutputCheck.Checked;
  3508. FOptions.UnderlineErrors := OptionsForm.UnderlineErrorsCheck.Checked;
  3509. FOptions.CursorPastEOL := OptionsForm.CursorPastEOLCheck.Checked;
  3510. FOptions.TabWidth := StrToInt(OptionsForm.TabWidthEdit.Text);
  3511. FOptions.UseTabCharacter := OptionsForm.UseTabCharacterCheck.Checked;
  3512. FOptions.ShowWhiteSpace := OptionsForm.ShowWhiteSpaceCheck.Checked;
  3513. FOptions.SmartHome := OptionsForm.SmartHomeCheck.Checked;
  3514. FOptions.UseFolding := OptionsForm.UseFoldingCheck.Checked;
  3515. FOptions.AutoIndent := OptionsForm.AutoIndentCheck.Checked;
  3516. FOptions.IndentationGuides := OptionsForm.IndentationGuidesCheck.Checked;
  3517. FOptions.GutterLineNumbers := OptionsForm.GutterLineNumbersCheck.Checked;
  3518. FOptions.ShowPreprocessorOutput := OptionsForm.ShowPreprocessorOutputCheck.Checked;
  3519. FOptions.OpenIncludedFiles := OptionsForm.OpenIncludedFilesCheck.Checked;
  3520. FOptions.AutoHideNewIncludedFiles := OptionsForm.AutoHideNewIncludedFilesCheck.Checked;
  3521. FOptions.KeyMappingType := TKeyMappingType(OptionsForm.KeyMappingComboBox.ItemIndex);
  3522. FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(OptionsForm.MemoKeyMappingComboBox.ItemIndex);
  3523. FOptions.ThemeType := TThemeType(OptionsForm.ThemeComboBox.ItemIndex);
  3524. FOptions.HighlightWordAtCursorOccurrences := OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked;
  3525. FOptions.HighlightSelTextOccurrences := OptionsForm.HighlightSelTextOccurrencesCheck.Checked;
  3526. UpdateCaption;
  3527. UpdatePreprocMemos;
  3528. InvalidateStatusPanel(spHiddenFilesCount);
  3529. for Memo in FMemos do begin
  3530. { Move caret to start of line to ensure it doesn't end up in the middle
  3531. of a double-byte character if the code page changes from SBCS to DBCS }
  3532. Memo.CaretLine := Memo.CaretLine;
  3533. Memo.Font.Assign(OptionsForm.FontPanel.Font);
  3534. end;
  3535. SyncEditorOptions;
  3536. UpdateMarginsAndSquigglyAndCaretWidths;
  3537. UpdateNewMainFileButtons;
  3538. UpdateOccurrenceIndicators(FActiveMemo);
  3539. UpdateKeyMapping;
  3540. UpdateTheme;
  3541. { Save new options }
  3542. Ini := TConfigIniFile.Create;
  3543. try
  3544. Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
  3545. Ini.WriteBool('Options', 'UseWizard', FOptions.UseWizard);
  3546. Ini.WriteBool('Options', 'Autosave', FOptions.Autosave);
  3547. Ini.WriteBool('Options', 'Autoreload', FOptions.Autoreload);
  3548. Ini.WriteBool('Options', 'MakeBackups', FOptions.MakeBackups);
  3549. Ini.WriteBool('Options', 'FullPathInTitleBar', FOptions.FullPathInTitleBar);
  3550. Ini.WriteBool('Options', 'UndoAfterSave', FOptions.UndoAfterSave);
  3551. Ini.WriteBool('Options', 'UndoAfterReload', FOptions.UndoAfterReload);
  3552. Ini.WriteBool('Options', 'PauseOnDebuggerExceptions', FOptions.PauseOnDebuggerExceptions);
  3553. Ini.WriteBool('Options', 'RunAsDifferentUser', FOptions.RunAsDifferentUser);
  3554. Ini.WriteBool('Options', 'AutoComplete', FOptions.AutoAutoComplete);
  3555. Ini.WriteBool('Options', 'AutoCallTips', FOptions.AutoCallTips);
  3556. Ini.WriteBool('Options', 'UseSynHigh', FOptions.UseSyntaxHighlighting);
  3557. Ini.WriteBool('Options', 'ColorizeCompilerOutput', FOptions.ColorizeCompilerOutput);
  3558. Ini.WriteBool('Options', 'UnderlineErrors', FOptions.UnderlineErrors);
  3559. Ini.WriteBool('Options', 'HighlightWordAtCursorOccurrences', FOptions.HighlightWordAtCursorOccurrences);
  3560. Ini.WriteBool('Options', 'HighlightSelTextOccurrences', FOptions.HighlightSelTextOccurrences);
  3561. Ini.WriteBool('Options', 'EditorCursorPastEOL', FOptions.CursorPastEOL);
  3562. Ini.WriteInteger('Options', 'TabWidth', FOptions.TabWidth);
  3563. Ini.WriteBool('Options', 'UseTabCharacter', FOptions.UseTabCharacter);
  3564. Ini.WriteBool('Options', 'ShowWhiteSpace', FOptions.ShowWhiteSpace);
  3565. Ini.WriteBool('Options', 'SmartHome', FOptions.SmartHome);
  3566. Ini.WriteBool('Options', 'UseFolding', FOptions.UseFolding);
  3567. Ini.WriteBool('Options', 'AutoIndent', FOptions.AutoIndent);
  3568. Ini.WriteBool('Options', 'IndentationGuides', FOptions.IndentationGuides);
  3569. Ini.WriteBool('Options', 'GutterLineNumbers', FOptions.GutterLineNumbers);
  3570. Ini.WriteBool('Options', 'ShowPreprocessorOutput', FOptions.ShowPreprocessorOutput);
  3571. Ini.WriteBool('Options', 'OpenIncludedFiles', FOptions.OpenIncludedFiles);
  3572. Ini.WriteBool('Options', 'AutoHideNewIncludedFiles', FOptions.AutoHideNewIncludedFiles);
  3573. Ini.WriteInteger('Options', 'KeyMappingType', Ord(FOptions.KeyMappingType));
  3574. Ini.WriteInteger('Options', 'MemoKeyMappingType', Ord(FOptions.MemoKeyMappingType));
  3575. Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see Destroy }
  3576. Ini.WriteString('Options', 'EditorFontName', FMainMemo.Font.Name);
  3577. Ini.WriteInteger('Options', 'EditorFontSize', FMainMemo.Font.Size);
  3578. Ini.WriteInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
  3579. finally
  3580. Ini.Free;
  3581. end;
  3582. finally
  3583. OptionsForm.Free;
  3584. end;
  3585. end;
  3586. { Also see TabIndexToMemoIndex }
  3587. function TMainForm.MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
  3588. begin
  3589. if AMemo = FMainMemo then
  3590. Result := 0 { First tab displays the main memo }
  3591. else if AMemo = FPreprocessorOutputMemo then begin
  3592. if not FPreprocessorOutputMemo.Used then
  3593. raise Exception.Create('not FPreprocessorOutputMemo.Used');
  3594. Result := MemosTabSet.Tabs.Count-1 { Last tab displays the preprocessor output memo }
  3595. end else begin
  3596. Result := Integer(FFileMemos.IndexOf(AMemo as TIDEScintFileEdit)); { Other tabs display include files which start second tab }
  3597. { Filter memos explicitly hidden by the user }
  3598. for var MemoIndex := Result-1 downto 0 do
  3599. if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) <> -1 then
  3600. Dec(Result);
  3601. end;
  3602. end;
  3603. { Also see MemoToTabIndex }
  3604. function TMainForm.TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
  3605. begin
  3606. if ATabIndex = 0 then
  3607. Result := FMemos[0] { First tab displays the main memo which is FMemos[0] }
  3608. else if FPreprocessorOutputMemo.Used and (ATabIndex = AMaxTabIndex) then
  3609. Result := FMemos[1] { Last tab displays the preprocessor output memo which is FMemos[1] }
  3610. else begin
  3611. { Only count memos not explicitly hidden by the user }
  3612. var TabIndex := 0;
  3613. for var MemoIndex := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
  3614. if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) = -1 then begin
  3615. Inc(TabIndex);
  3616. if TabIndex = ATabIndex then begin
  3617. Result := FMemos[MemoIndex + 1]; { Other tabs display include files which start at second tab but at FMemos[2] }
  3618. Exit;
  3619. end;
  3620. end;
  3621. end;
  3622. raise Exception.Create('TabIndexToMemo failed');
  3623. end;
  3624. end;
  3625. procedure TMainForm.MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
  3626. const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean; const IsPosition: Boolean;
  3627. const PositionVirtualSpace: Integer);
  3628. var
  3629. Pos: Integer;
  3630. begin
  3631. { Reopen tab if needed }
  3632. if AMemo is TIDEScintFileEdit then begin
  3633. var FileName := (AMemo as TIDEScintFileEdit).Filename;
  3634. var HiddenFileIndex := FHiddenFiles.IndexOf(Filename);
  3635. if HiddenFileIndex <> -1 then begin
  3636. ReopenTabOrTabs(HiddenFileIndex, False);
  3637. { The above call to ReopenTabOrTabs will currently lead to a call to UpdateIncludedFilesMemos which
  3638. sets up all the memos. Currently it will keep same memo for the reopened file but in case it no
  3639. longer does at some point: look it up again }
  3640. AMemo := nil;
  3641. for var Memo in FFileMemos do begin
  3642. if Memo.Used and (PathCompare(Memo.Filename, Filename) = 0) then begin
  3643. AMemo := Memo;
  3644. Break;
  3645. end;
  3646. end;
  3647. if AMemo = nil then
  3648. raise Exception.Create('AMemo MIA');
  3649. end;
  3650. end;
  3651. { Move caret }
  3652. if IsPosition then
  3653. Pos := LineNumberOrPosition
  3654. else if AlwaysResetColumnEvenIfOnRequestedLineAlready or (AMemo.CaretLine <> LineNumberOrPosition) then
  3655. Pos := AMemo.GetPositionFromLine(LineNumberOrPosition)
  3656. else
  3657. Pos := AMemo.CaretPosition; { Not actually moving caret - it's already were we want it}
  3658. { If the line is in a contracted section, expand it }
  3659. AMemo.EnsureLineVisible(AMemo.GetLineFromPosition(Pos));
  3660. { If the line isn't in view, scroll so that it's in the center }
  3661. if not AMemo.IsPositionInViewVertically(Pos) then
  3662. AMemo.TopLine := AMemo.GetVisibleLineFromDocLine(AMemo.GetLineFromPosition(Pos)) -
  3663. (AMemo.LinesInWindow div 2);
  3664. AMemo.CaretPosition := Pos;
  3665. if IsPosition then
  3666. AMemo.CaretVirtualSpace := PositionVirtualSpace;
  3667. { Activate memo }
  3668. MemosTabSet.TabIndex := MemoToTabIndex(AMemo); { This causes MemosTabSetClick to show the memo }
  3669. end;
  3670. procedure TMainForm.SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
  3671. var
  3672. OldLine: Integer;
  3673. begin
  3674. if AMemo <> FErrorMemo then begin
  3675. SetErrorLine(FErrorMemo, -1);
  3676. FErrorMemo := AMemo;
  3677. end;
  3678. if FErrorMemo.ErrorLine <> ALine then begin
  3679. OldLine := FErrorMemo.ErrorLine;
  3680. FErrorMemo.ErrorLine := ALine;
  3681. if OldLine >= 0 then
  3682. UpdateLineMarkers(FErrorMemo, OldLine);
  3683. if FErrorMemo.ErrorLine >= 0 then begin
  3684. FErrorMemo.ErrorCaretPosition := FErrorMemo.CaretPosition;
  3685. UpdateLineMarkers(FErrorMemo, FErrorMemo.ErrorLine);
  3686. end;
  3687. end;
  3688. end;
  3689. procedure TMainForm.SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
  3690. var
  3691. OldLine: Integer;
  3692. begin
  3693. if AMemo <> FStepMemo then begin
  3694. SetStepLine(FStepMemo, -1);
  3695. FStepMemo := AMemo;
  3696. end;
  3697. if FStepMemo.StepLine <> ALine then begin
  3698. OldLine := FStepMemo.StepLine;
  3699. FStepMemo.StepLine := ALine;
  3700. if OldLine >= 0 then
  3701. UpdateLineMarkers(FStepMemo, OldLine);
  3702. if FStepMemo.StepLine >= 0 then
  3703. UpdateLineMarkers(FStepMemo, FStepMemo.StepLine);
  3704. end;
  3705. end;
  3706. procedure TMainForm.HideError;
  3707. begin
  3708. SetErrorLine(FErrorMemo, -1);
  3709. if not FCompiling then
  3710. StatusBar.Panels[spExtraStatus].Text := '';
  3711. end;
  3712. procedure TMainForm.BackNavButtonClick(Sender: TObject);
  3713. begin
  3714. NavigateBack;
  3715. end;
  3716. procedure TMainForm.ForwardNavButtonClick(Sender: TObject);
  3717. begin
  3718. NavigateForward;
  3719. end;
  3720. procedure TMainForm.WMAppCommand(var Message: TMessage);
  3721. begin
  3722. HandleNavigationAppCommand(Message);
  3723. end;
  3724. procedure TMainForm.NavPopupMenuClick(Sender: TObject);
  3725. begin
  3726. UpdateNavigationMenu(Sender as TMenuItem);
  3727. end;
  3728. procedure TMainForm.UpdateCaretPosPanelAndBackNavStack;
  3729. begin
  3730. { Update panel }
  3731. var Text := Format('%4d:%4d', [FActiveMemo.CaretLine + 1,
  3732. FActiveMemo.CaretColumnExpandedForTabs + 1]);
  3733. if FOptions.ShowCaretPosition then begin
  3734. const CaretPos = FActiveMemo.CaretPosition;
  3735. const Section = FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine], False);
  3736. const Style = FActiveMemo.GetStyleAtPosition(CaretPos);
  3737. Text := Format('%s-%s@%d+%d:%s', [
  3738. Copy(GetEnumName(TypeInfo(TInnoSetupStylerSection), Ord(Section)), 3, MaxInt),
  3739. Copy(GetEnumName(TypeInfo(TInnoSetupStylerStyle), Style), 3, MaxInt),
  3740. CaretPos, FActiveMemo.CaretVirtualSpace, Text]);
  3741. end;
  3742. StatusBar.Panels[spCaretPos].Text := Text;
  3743. UpdateBackNavigationStack;
  3744. end;
  3745. procedure TMainForm.UpdateEditModeStatusPanel;
  3746. const
  3747. InsertText: array[Boolean] of String = ('Overwrite', 'Insert');
  3748. begin
  3749. if FActiveMemo.ReadOnly then
  3750. StatusBar.Panels[spEditMode].Text := 'Read only'
  3751. else
  3752. StatusBar.Panels[spEditMode].Text := InsertText[FActiveMemo.InsertMode];
  3753. end;
  3754. procedure TMainForm.UpdateFindRegExUI;
  3755. const
  3756. FindRegExText: array[Boolean] of String = ('', '.*');
  3757. begin
  3758. StatusBar.Panels[spFindRegEx].Text := FindRegExText[FOptions.FindRegEx];
  3759. if FOptions.FindRegEx then begin
  3760. FindDialog.Options := FindDialog.Options + [frHideWholeWord];
  3761. ReplaceDialog.Options := ReplaceDialog.Options + [frHideWholeWord];
  3762. end else begin
  3763. FindDialog.Options := FindDialog.Options - [frHideWholeWord];
  3764. ReplaceDialog.Options := ReplaceDialog.Options - [frHideWholeWord];
  3765. end;
  3766. end;
  3767. procedure TMainForm.UpdateMemosTabSetVisibility;
  3768. begin
  3769. MemosTabSet.Visible := FPreprocessorOutputMemo.Used or FFileMemos[FirstIncludedFilesMemoIndex].Used;
  3770. if not MemosTabSet.Visible then
  3771. MemosTabSet.TabIndex := 0; { For next time }
  3772. end;
  3773. procedure TMainForm.UpdateModifiedStatusPanel;
  3774. begin
  3775. if FActiveMemo.Modified then
  3776. StatusBar.Panels[spModified].Text := 'Modified'
  3777. else
  3778. StatusBar.Panels[spModified].Text := '';
  3779. end;
  3780. { Set DontUpdateRelatedVisibilty if you're going to call this function again, avoids flicker }
  3781. procedure TMainForm.UpdatePreprocMemos(const DontUpdateRelatedVisibilty: Boolean);
  3782. procedure UpdatePreprocessorOutputMemo(const NewTabs, NewHints: TStringList;
  3783. const NewCloseButtons: TBoolList);
  3784. begin
  3785. if FOptions.ShowPreprocessorOutput and (FPreprocessorOutput <> '') and
  3786. (FMainMemo.Lines.Text.TrimRight <> FPreprocessorOutput) then begin
  3787. NewTabs.Add('Preprocessor Output');
  3788. NewHints.Add('');
  3789. NewCloseButtons.Add(False);
  3790. FPreprocessorOutputMemo.ReadOnly := False;
  3791. try
  3792. FPreprocessorOutputMemo.Lines.Text := FPreprocessorOutput;
  3793. FPreprocessorOutputMemo.ClearUndo;
  3794. finally
  3795. FPreprocessorOutputMemo.ReadOnly := True;
  3796. end;
  3797. FPreprocessorOutputMemo.Used := True;
  3798. end else begin
  3799. if FPreprocessorOutputMemo.Used then
  3800. RemoveMemoFromNavigation(FPreprocessorOutputMemo);
  3801. FPreprocessorOutputMemo.Used := False;
  3802. FPreprocessorOutputMemo.Visible := False;
  3803. end;
  3804. end;
  3805. procedure UpdateIncludedFilesMemos(const NewTabs, NewHints: TStringList;
  3806. const NewCloseButtons: TBoolList);
  3807. begin
  3808. if FOptions.OpenIncludedFiles and (FIncludedFiles.Count > 0) then begin
  3809. var NextMemoIndex := FirstIncludedFilesMemoIndex;
  3810. var NextTabIndex := 1; { First tab displays the main memo }
  3811. for var IncludedFileIndex := 0 to FIncludedFiles.Count-1 do begin
  3812. const IncludedFile = FIncludedFiles[IncludedFileIndex];
  3813. if NextMemoIndex = FFileMemos.Count then begin
  3814. { We're out of memos :( }
  3815. IncludedFile.Memo := nil;
  3816. Continue;
  3817. end;
  3818. IncludedFile.Memo := FFileMemos[NextMemoIndex];
  3819. try
  3820. if not IncludedFile.Memo.Used or
  3821. not PathSame(IncludedFile.Memo.Filename, IncludedFile.Filename) or
  3822. not IncludedFile.HasLastWriteTime or
  3823. (CompareFileTime(IncludedFile.Memo.FileLastWriteTime, IncludedFile.LastWriteTime) <> 0) then begin
  3824. IncludedFile.Memo.Filename := IncludedFile.Filename;
  3825. IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
  3826. OpenFile(IncludedFile.Memo, IncludedFile.Filename, False); { Also updates FileLastWriteTime }
  3827. IncludedFile.Memo.Used := True;
  3828. end else begin
  3829. { The memo assigned to the included file already has that file loaded
  3830. and is up-to-date so no call to OpenFile is needed. However, it could be
  3831. that CompilerFileIndex is not set yet. This happens if the initial
  3832. load was from the history loaded by LoadKnownIncludedAndHiddenFiles
  3833. and is followed by the user doing a compile. }
  3834. if IncludedFile.Memo.CompilerFileIndex = UnknownCompilerFileIndex then
  3835. IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
  3836. end;
  3837. if FHiddenFiles.IndexOf(IncludedFile.Filename) = -1 then begin
  3838. NewTabs.Insert(NextTabIndex, GetDisplayFilename(IncludedFile.Filename));
  3839. NewHints.Insert(NextTabIndex, GetFileTitle(IncludedFile.Filename));
  3840. NewCloseButtons.Insert(NextTabIndex, True);
  3841. Inc(NextTabIndex);
  3842. end;
  3843. Inc(NextMemoIndex);
  3844. except on E: Exception do
  3845. begin
  3846. StatusMessage(smkWarning, 'Failed to open included file: ' + E.Message);
  3847. IncludedFile.Memo := nil;
  3848. end;
  3849. end;
  3850. end;
  3851. { Hide any remaining memos }
  3852. for var I := NextMemoIndex to FFileMemos.Count-1 do begin
  3853. FFileMemos[I].BreakPoints.Clear;
  3854. if FFileMemos[I].Used then
  3855. RemoveMemoFromNavigation(FFileMemos[I]);
  3856. FFileMemos[I].Used := False;
  3857. FFileMemos[I].Visible := False;
  3858. end;
  3859. end else begin
  3860. for var I := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
  3861. FFileMemos[I].BreakPoints.Clear;
  3862. if FFileMemos[I].Used then
  3863. RemoveMemoFromNavigation(FFileMemos[I]);
  3864. FFileMemos[I].Used := False;
  3865. FFileMemos[I].Visible := False;
  3866. end;
  3867. for var IncludedFile in FIncludedFiles do
  3868. IncludedFile.Memo := nil;
  3869. end;
  3870. end;
  3871. var
  3872. NewTabs, NewHints: TStringList;
  3873. NewCloseButtons: TBoolList;
  3874. I, SaveTabIndex: Integer;
  3875. SaveTabName: String;
  3876. begin
  3877. NewTabs := nil;
  3878. NewHints := nil;
  3879. NewCloseButtons := nil;
  3880. try
  3881. NewTabs := TStringList.Create;
  3882. NewTabs.Add(MemosTabSet.Tabs[0]); { 'Main Script' }
  3883. NewHints := TStringList.Create;
  3884. NewHints.Add(GetFileTitle(FMainMemo.Filename));
  3885. NewCloseButtons := TBoolList.Create;
  3886. NewCloseButtons.Add(False);
  3887. UpdatePreprocessorOutputMemo(NewTabs, NewHints, NewCloseButtons);
  3888. UpdateIncludedFilesMemos(NewTabs, NewHints, NewCloseButtons);
  3889. { Set new tabs, try keep same file open }
  3890. SaveTabIndex := MemosTabSet.TabIndex;
  3891. SaveTabName := MemosTabSet.Tabs[MemosTabSet.TabIndex];
  3892. MemosTabSet.Tabs := NewTabs;
  3893. MemosTabSet.Hints := NewHints;
  3894. MemosTabSet.CloseButtons := NewCloseButtons;
  3895. I := MemosTabSet.Tabs.IndexOf(SaveTabName);
  3896. if I <> -1 then
  3897. MemosTabSet.TabIndex := I;
  3898. if MemosTabSet.TabIndex = SaveTabIndex then begin
  3899. { If TabIndex stayed the same then the tabset won't perform a Click but we need this to make
  3900. sure the right memo is visible - so trigger it ourselves }
  3901. MemosTabSetClick(MemosTabSet);
  3902. end;
  3903. finally
  3904. NewCloseButtons.Free;
  3905. NewHints.Free;
  3906. NewTabs.Free;
  3907. end;
  3908. if not DontUpdateRelatedVisibilty then begin
  3909. UpdateMemosTabSetVisibility;
  3910. UpdateBevel1Visibility;
  3911. end;
  3912. end;
  3913. procedure TMainForm.MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
  3914. procedure UpdatePendingSquiggly(const AMemo: TIDEScintEdit);
  3915. var
  3916. Pos: Integer;
  3917. Value: Boolean;
  3918. begin
  3919. { Check for the inPendingSquiggly indicator on either side of the caret }
  3920. Pos := AMemo.CaretPosition;
  3921. Value := False;
  3922. if AMemo.CaretVirtualSpace = 0 then begin
  3923. Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos);
  3924. if not Value and (Pos > 0) then
  3925. Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos-1);
  3926. end;
  3927. if FOnPendingSquiggly <> Value then begin
  3928. FOnPendingSquiggly := Value;
  3929. { If caret has left a pending squiggly, force restyle of the line }
  3930. if not Value then begin
  3931. { Stop reporting the caret position to the styler (until the next
  3932. Change event) so the token doesn't re-enter pending-squiggly state
  3933. if the caret comes back and something restyles the line }
  3934. AMemo.ReportCaretPositionToStyler := False;
  3935. AMemo.RestyleLine(AMemo.GetLineFromPosition(FPendingSquigglyCaretPos));
  3936. end;
  3937. end;
  3938. FPendingSquigglyCaretPos := Pos;
  3939. end;
  3940. procedure UpdateBraceHighlighting(const AMemo: TIDEScintEdit);
  3941. const
  3942. OpeningBraces: TSysCharSet = ['(', '[', '{', '<'];
  3943. ClosingBraces: TSysCharSet = [')', ']', '}', '>'];
  3944. function HighlightPos(const AMemo: TIDEScintEdit; const CaretPos: Integer;
  3945. const Before: Boolean; const Braces: TSysCharSet): Boolean;
  3946. begin
  3947. var Pos := CaretPos;
  3948. if Before then begin
  3949. if Pos > 0 then
  3950. Pos := AMemo.GetPositionBefore(Pos)
  3951. else
  3952. Exit(False);
  3953. end;
  3954. var C := AMemo.GetByteAtPosition(Pos);
  3955. Result := C in Braces;
  3956. if Result then begin
  3957. var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos);
  3958. if MatchPos >= 0 then
  3959. AMemo.SetBraceHighlighting(Pos, MatchPos)
  3960. else begin
  3961. { Found an unmatched brace: highlight it as bad unless it's an opening
  3962. brace and the caret is at the end of the line }
  3963. var CaretLineEndPos := AMemo.GetLineEndPosition(AMemo.CaretLine);
  3964. if (C in ClosingBraces) or (CaretPos <> CaretLineEndPos) then
  3965. AMemo.SetBraceBadHighlighting(Pos)
  3966. else
  3967. AMemo.SetBraceHighlighting(-1, -1);
  3968. end;
  3969. end;
  3970. end;
  3971. begin
  3972. var Highlighted := False;
  3973. var Section := FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[AMemo.CaretLine]);
  3974. if (Section <> scNone) and (AMemo.CaretVirtualSpace = 0) then begin
  3975. var Pos := AMemo.CaretPosition;
  3976. Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, OpeningBraces);
  3977. Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, ClosingBraces);
  3978. Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, ClosingBraces);
  3979. Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, OpeningBraces);
  3980. end;
  3981. if not Highlighted then
  3982. AMemo.SetBraceHighlighting(-1, -1);
  3983. end;
  3984. begin
  3985. if Updated * [suContent, suSelection] = [] then
  3986. Exit;
  3987. var Memo := Sender as TIDEScintEdit;
  3988. if (Memo = FErrorMemo) and ((FErrorMemo.ErrorLine < 0) or (FErrorMemo.CaretPosition <> FErrorMemo.ErrorCaretPosition)) then
  3989. HideError;
  3990. if Memo = FActiveMemo then begin
  3991. UpdateCaretPosPanelAndBackNavStack;
  3992. UpdateEditModeStatusPanel;
  3993. end;
  3994. UpdatePendingSquiggly(Memo);
  3995. UpdateBraceHighlighting(Memo);
  3996. UpdateOccurrenceIndicators(Memo);
  3997. end;
  3998. procedure TMainForm.MemoModifiedChange(Sender: TObject);
  3999. begin
  4000. if Sender = FActiveMemo then
  4001. UpdateModifiedStatusPanel;
  4002. end;
  4003. procedure TMainForm.MemoCallTipArrowClick(Sender: TObject;
  4004. const Up: Boolean);
  4005. begin
  4006. CallTipsHandleArrowClick(FActiveMemo, Up);
  4007. end;
  4008. procedure TMainForm.MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
  4009. procedure MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer);
  4010. begin
  4011. for var I := 0 to FDebugEntriesCount-1 do
  4012. if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
  4013. (FDebugEntries[I].LineNumber >= FirstLine) then
  4014. Inc(FDebugEntries[I].LineNumber, Count);
  4015. for var I := FindResultsList.Items.Count-1 downto 0 do begin
  4016. const FindResult = FindResultsList.Items.Objects[I] as TFindResult;
  4017. if FindResult <> nil then begin
  4018. if PathSame(FindResult.Filename, Memo.Filename) and
  4019. (FindResult.Line >= FirstLine) then begin
  4020. const NewLine = FindResult.Line + Count;
  4021. UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine));
  4022. end;
  4023. end;
  4024. end;
  4025. if Assigned(Memo.LineState) and (FirstLine < Memo.LineStateCount) then begin
  4026. { Grow FStateLine if necessary }
  4027. var GrowAmount := (Memo.LineStateCount + Count) - Memo.LineStateCapacity;
  4028. if GrowAmount > 0 then begin
  4029. if GrowAmount < LineStateGrowAmount then
  4030. GrowAmount := LineStateGrowAmount;
  4031. ReallocMem(Memo.LineState, SizeOf(TLineState) * (Memo.LineStateCapacity + GrowAmount));
  4032. Inc(Memo.LineStateCapacity, GrowAmount);
  4033. end;
  4034. { Shift existing line states and clear the new ones }
  4035. for var I := Memo.LineStateCount-1 downto FirstLine do
  4036. Memo.LineState[I + Count] := Memo.LineState[I];
  4037. for var I := FirstLine to FirstLine + Count - 1 do
  4038. Memo.LineState[I] := lnUnknown;
  4039. Inc(Memo.LineStateCount, Count);
  4040. end;
  4041. if Memo.StepLine >= FirstLine then
  4042. Inc(Memo.StepLine, Count);
  4043. if Memo.ErrorLine >= FirstLine then
  4044. Inc(Memo.ErrorLine, Count);
  4045. var BreakPointsChanged := False;
  4046. for var I := 0 to Memo.BreakPoints.Count-1 do begin
  4047. const Line = Memo.BreakPoints[I];
  4048. if Line >= FirstLine then begin
  4049. Memo.BreakPoints[I] := Line + Count;
  4050. BreakPointsChanged := True;
  4051. end;
  4052. end;
  4053. if BreakPointsChanged then
  4054. BuildAndSaveBreakPointLines(Memo);
  4055. FNavStacks.LinesInserted(Memo, FirstLine, Count);
  4056. end;
  4057. procedure MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count,
  4058. FirstAffectedLine: Integer);
  4059. begin
  4060. for var I := 0 to FDebugEntriesCount-1 do begin
  4061. const DebugEntry: PDebugEntry = @FDebugEntries[I];
  4062. if (DebugEntry.FileIndex = Memo.CompilerFileIndex) and
  4063. (DebugEntry.LineNumber >= FirstLine) then begin
  4064. if DebugEntry.LineNumber < FirstLine + Count then
  4065. DebugEntry.LineNumber := -1
  4066. else
  4067. Dec(DebugEntry.LineNumber, Count);
  4068. end;
  4069. end;
  4070. for var I := FindResultsList.Items.Count-1 downto 0 do begin
  4071. const FindResult = FindResultsList.Items.Objects[I] as TFindResult;
  4072. if FindResult <> nil then begin
  4073. if PathSame(FindResult.Filename, Memo.Filename) and
  4074. (FindResult.Line >= FirstLine) then begin
  4075. if FindResult.Line < FirstLine + Count then
  4076. FindResultsList.Items.Delete(I)
  4077. else begin
  4078. const NewLine = FindResult.Line - Count;
  4079. UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine));
  4080. end;
  4081. end;
  4082. end;
  4083. end;
  4084. if Assigned(Memo.LineState) then begin
  4085. { Shift existing line states }
  4086. if FirstLine < Memo.LineStateCount - Count then begin
  4087. for var I := FirstLine to Memo.LineStateCount - Count - 1 do
  4088. Memo.LineState[I] := Memo.LineState[I + Count];
  4089. Dec(Memo.LineStateCount, Count);
  4090. end
  4091. else begin
  4092. { There's nothing to shift because the last line(s) were deleted, or
  4093. line(s) past FLineStateCount }
  4094. if Memo.LineStateCount > FirstLine then
  4095. Memo.LineStateCount := FirstLine;
  4096. end;
  4097. end;
  4098. if Memo.StepLine >= FirstLine then begin
  4099. if Memo.StepLine < FirstLine + Count then
  4100. Memo.StepLine := -1
  4101. else
  4102. Dec(Memo.StepLine, Count);
  4103. end;
  4104. if Memo.ErrorLine >= FirstLine then begin
  4105. if Memo.ErrorLine < FirstLine + Count then
  4106. Memo.ErrorLine := -1
  4107. else
  4108. Dec(Memo.ErrorLine, Count);
  4109. end;
  4110. var BreakPointsChanged := False;
  4111. for var I := Memo.BreakPoints.Count-1 downto 0 do begin
  4112. const Line = Memo.BreakPoints[I];
  4113. if Line >= FirstLine then begin
  4114. if Line < FirstLine + Count then begin
  4115. Memo.BreakPoints.Delete(I);
  4116. BreakPointsChanged := True;
  4117. end else begin
  4118. Memo.BreakPoints[I] := Line - Count;
  4119. BreakPointsChanged := True;
  4120. end;
  4121. end;
  4122. end;
  4123. if BreakPointsChanged then
  4124. BuildAndSaveBreakPointLines(Memo);
  4125. if FNavStacks.LinesDeleted(Memo, FirstLine, Count) then
  4126. UpdateNavigationButtons;
  4127. { We do NOT update FCurrentNavItem here so it might point to a line that's
  4128. deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI }
  4129. { When lines are deleted, Scintilla insists on moving all of the deleted
  4130. lines' markers to the line on which the deletion started
  4131. (FirstAffectedLine). This is bad for us as e.g. it can result in the line
  4132. having two conflicting markers (or two of the same marker). There's no
  4133. way to stop it from doing that, or to easily tell which markers came from
  4134. which lines, so we simply delete and re-create all markers on the line. }
  4135. UpdateLineMarkers(Memo, FirstAffectedLine);
  4136. end;
  4137. procedure MemoLinesInsertedOrDeleted(Memo: TIDEScintFileEdit);
  4138. var
  4139. FirstAffectedLine, Line, LinePos: Integer;
  4140. begin
  4141. Line := Memo.GetLineFromPosition(Info.StartPos);
  4142. LinePos := Memo.GetPositionFromLine(Line);
  4143. FirstAffectedLine := Line;
  4144. { If the deletion/insertion does not start on the first character of Line,
  4145. then we consider the first deleted/inserted line to be the following
  4146. line (Line+1). This way, if you press Del at the end of line 1, the dot
  4147. on line 2 is removed, while line 1's dot stays intact. }
  4148. if Info.StartPos > LinePos then
  4149. Inc(Line);
  4150. if Info.LinesDelta > 0 then
  4151. MemoLinesInserted(Memo, Line, Info.LinesDelta)
  4152. else
  4153. MemoLinesDeleted(Memo, Line, -Info.LinesDelta, FirstAffectedLine);
  4154. end;
  4155. var
  4156. Memo: TIDEScintFileEdit;
  4157. begin
  4158. if not (Sender is TIDEScintFileEdit) then
  4159. Exit;
  4160. Memo := TIDEScintFileEdit(Sender);
  4161. if Memo.OpeningFile then
  4162. Exit;
  4163. FModifiedAnySinceLastCompile := True;
  4164. if FDebugging then
  4165. FModifiedAnySinceLastCompileAndGo := True
  4166. else begin
  4167. { Modified while not debugging or opening a file; free the debug info and clear the dots }
  4168. DestroyDebugInfo;
  4169. end;
  4170. if Info.LinesDelta <> 0 then
  4171. MemoLinesInsertedOrDeleted(Memo);
  4172. if Memo = FErrorMemo then begin
  4173. { When the Delete key is pressed, the caret doesn't move, so reset
  4174. FErrorCaretPosition to ensure that OnUpdateUI calls HideError }
  4175. FErrorMemo.ErrorCaretPosition := -1;
  4176. end;
  4177. { The change should trigger restyling. Allow the styler to see the current
  4178. caret position in case it wants to set a pending squiggly indicator. }
  4179. Memo.ReportCaretPositionToStyler := True;
  4180. end;
  4181. procedure TMainForm.MemoCharAdded(Sender: TObject; Ch: AnsiChar);
  4182. function LineIsBlank(const Line: Integer): Boolean;
  4183. begin
  4184. var S := FActiveMemo.Lines.RawLines[Line];
  4185. Result := TScintEdit.RawStringIsBlank(S);
  4186. end;
  4187. begin
  4188. if FOptions.AutoIndent and (Ch = FActiveMemo.LineEndingString[Length(FActiveMemo.LineEndingString)]) then begin
  4189. { Add to the new line any (remaining) indentation from the previous line }
  4190. const NewLine = FActiveMemo.CaretLine;
  4191. var PreviousLine := NewLine-1;
  4192. if PreviousLine >= 0 then begin
  4193. const NewIndent = FActiveMemo.GetLineIndentation(NewLine);
  4194. { If no indentation was moved from the previous line to the new line
  4195. (i.e., there are no spaces/tabs directly to the right of the new
  4196. caret position), and the previous line is completely empty (0 length),
  4197. then use the indentation from the last line containing non-space
  4198. characters. }
  4199. if (NewIndent = 0) and (FActiveMemo.Lines.RawLineLengths[PreviousLine] = 0) then begin
  4200. Dec(PreviousLine);
  4201. while (PreviousLine >= 0) and LineIsBlank(PreviousLine) do
  4202. Dec(PreviousLine);
  4203. end;
  4204. if PreviousLine >= 0 then begin
  4205. const PreviousIndent = FActiveMemo.GetLineIndentation(PreviousLine);
  4206. FActiveMemo.SetLineIndentation(NewLine, NewIndent + PreviousIndent);
  4207. FActiveMemo.CaretPosition := FActiveMemo.GetPositionFromLineExpandedColumn(NewLine,
  4208. PreviousIndent);
  4209. end;
  4210. end;
  4211. end;
  4212. AutoCompleteAndCallTipsHandleCharAdded(FActiveMemo, Ch);
  4213. end;
  4214. procedure TMainForm.MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
  4215. function GetCodeVariableDebugEntryFromFileLineCol(FileIndex, Line, Col: Integer; out DebugEntry: PVariableDebugEntry): Boolean;
  4216. var
  4217. I: Integer;
  4218. begin
  4219. { FVariableDebugEntries uses 1-based line and column numbers }
  4220. Inc(Line);
  4221. Inc(Col);
  4222. Result := False;
  4223. for I := 0 to FVariableDebugEntriesCount-1 do begin
  4224. if (FVariableDebugEntries[I].FileIndex = FileIndex) and
  4225. (FVariableDebugEntries[I].LineNumber = Line) and
  4226. (FVariableDebugEntries[I].Col = Col) then begin
  4227. DebugEntry := @FVariableDebugEntries[I];
  4228. Result := True;
  4229. Break;
  4230. end;
  4231. end;
  4232. end;
  4233. function GetCodeColumnFromPosition(const Pos: Integer): Integer;
  4234. var
  4235. LinePos: Integer;
  4236. S: TScintRawString;
  4237. U: String;
  4238. begin
  4239. { [Code] lines get converted from the editor's UTF-8 to UTF-16 Strings when
  4240. passed to the compiler. This can lead to column number discrepancies
  4241. between Scintilla and ROPS. This code simulates the conversion to try to
  4242. find out where ROPS thinks a Pos resides. }
  4243. LinePos := FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos));
  4244. S := FActiveMemo.GetRawTextRange(LinePos, Pos);
  4245. U := FActiveMemo.ConvertRawStringToString(S);
  4246. Result := Length(U);
  4247. end;
  4248. function FindVarOrFuncRange(const Pos: Integer): TScintRange;
  4249. begin
  4250. { Note: The GetPositionAfter is needed so that when the mouse is over a '.'
  4251. between two words, it won't match the word to the left of the '.' }
  4252. FActiveMemo.SetDefaultWordChars;
  4253. Result.StartPos := FActiveMemo.GetWordStartPosition(FActiveMemo.GetPositionAfter(Pos), True);
  4254. Result.EndPos := FActiveMemo.GetWordEndPosition(Pos, True);
  4255. end;
  4256. function FindConstRange(const Pos: Integer): TScintRange;
  4257. var
  4258. BraceLevel, ConstStartPos, Line, LineEndPos, I: Integer;
  4259. C: AnsiChar;
  4260. begin
  4261. Result.StartPos := 0;
  4262. Result.EndPos := 0;
  4263. BraceLevel := 0;
  4264. ConstStartPos := -1;
  4265. Line := FActiveMemo.GetLineFromPosition(Pos);
  4266. LineEndPos := FActiveMemo.GetLineEndPosition(Line);
  4267. I := FActiveMemo.GetPositionFromLine(Line);
  4268. while I < LineEndPos do begin
  4269. if (I > Pos) and (BraceLevel = 0) then
  4270. Break;
  4271. C := FActiveMemo.GetByteAtPosition(I);
  4272. if C = '{' then begin
  4273. if FActiveMemo.GetByteAtPosition(I + 1) = '{' then
  4274. Inc(I)
  4275. else begin
  4276. if BraceLevel = 0 then
  4277. ConstStartPos := I;
  4278. Inc(BraceLevel);
  4279. end;
  4280. end
  4281. else if (C = '}') and (BraceLevel > 0) then begin
  4282. Dec(BraceLevel);
  4283. if (BraceLevel = 0) and (ConstStartPos <> -1) then begin
  4284. if (Pos >= ConstStartPos) and (Pos <= I) then begin
  4285. Result.StartPos := ConstStartPos;
  4286. Result.EndPos := I + 1;
  4287. Exit;
  4288. end;
  4289. ConstStartPos := -1;
  4290. end;
  4291. end;
  4292. I := FActiveMemo.GetPositionAfter(I);
  4293. end;
  4294. end;
  4295. procedure UpdateInfo(var Info: TScintHintInfo; const HintStr: String; const Range: TScintRange; const Memo: TIDEScintEdit);
  4296. begin
  4297. Info.HintStr := HintStr;
  4298. Info.CursorRect.TopLeft := Memo.GetPointFromPosition(Range.StartPos);
  4299. Info.CursorRect.BottomRight := Memo.GetPointFromPosition(Range.EndPos);
  4300. Info.CursorRect.Bottom := Info.CursorRect.Top + Memo.LineHeight;
  4301. Info.HideTimeout := High(Integer); { infinite }
  4302. end;
  4303. begin
  4304. var Pos := FActiveMemo.GetPositionFromPoint(Info.CursorPos, True, True);
  4305. if Pos < 0 then
  4306. Exit;
  4307. var Line := FActiveMemo.GetLineFromPosition(Pos);
  4308. { Check if cursor is over a [Code] variable or function }
  4309. if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]) = scCode then begin
  4310. var VarOrFuncRange := FindVarOrFuncRange(Pos);
  4311. if VarOrFuncRange.EndPos > VarOrFuncRange.StartPos then begin
  4312. var HintStr := '';
  4313. var DebugEntry: PVariableDebugEntry;
  4314. if (FActiveMemo is TIDEScintFileEdit) and (FDebugClientWnd <> 0) and
  4315. GetCodeVariableDebugEntryFromFileLineCol((FActiveMemo as TIDEScintFileEdit).CompilerFileIndex,
  4316. Line, GetCodeColumnFromPosition(VarOrFuncRange.StartPos), DebugEntry) then begin
  4317. var Output: String;
  4318. case EvaluateVariableEntry(DebugEntry, Output) of
  4319. 1, 2: HintStr := Output;
  4320. else
  4321. HintStr := 'Unknown error';
  4322. end;
  4323. end else begin
  4324. var ClassMember := False;
  4325. var Name := FActiveMemo.GetTextRange(VarOrFuncRange.StartPos, VarOrFuncRange.EndPos);
  4326. var Index := 0;
  4327. var Count: Integer;
  4328. var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
  4329. if Count = 0 then begin
  4330. ClassMember := not ClassMember;
  4331. FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
  4332. end;
  4333. while Index < Count do begin
  4334. if Index <> 0 then
  4335. FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index);
  4336. if HintStr <> '' then
  4337. HintStr := HintStr + #13;
  4338. if FunctionDefinition.HeaderKind = hkFunction then
  4339. HintStr := HintStr + 'function '
  4340. else if FunctionDefinition.HeaderKind = hkProcedure then
  4341. HintStr := HintStr + 'procedure '
  4342. else
  4343. HintStr := HintStr + 'constructor ';
  4344. HintStr := HintStr + String(FunctionDefinition.ScriptFuncWithoutHeader);
  4345. Inc(Index);
  4346. end;
  4347. end;
  4348. if HintStr <> '' then begin
  4349. UpdateInfo(Info, HintStr, VarOrFuncRange, FActiveMemo);
  4350. Exit;
  4351. end;
  4352. end;
  4353. end;
  4354. if FDebugClientWnd <> 0 then begin
  4355. { Check if cursor is over a constant }
  4356. var ConstRange := FindConstRange(Pos);
  4357. if ConstRange.EndPos > ConstRange.StartPos then begin
  4358. var HintStr := FActiveMemo.GetTextRange(ConstRange.StartPos, ConstRange.EndPos);
  4359. var Output: String;
  4360. case EvaluateConstant(Info.HintStr, Output) of
  4361. 1: HintStr := HintStr + ' = "' + Output + '"';
  4362. 2: HintStr := HintStr + ' = Exception: ' + Output;
  4363. else
  4364. HintStr := HintStr + ' = Unknown error';
  4365. end;
  4366. UpdateInfo(Info, HintStr, ConstRange, FActiveMemo);
  4367. end;
  4368. end;
  4369. end;
  4370. procedure TMainForm.MainMemoDropFiles(Sender: TObject; X, Y: Integer;
  4371. AFiles: TStrings);
  4372. begin
  4373. if (AFiles.Count > 0) and ConfirmCloseFile(True) then
  4374. OpenFile(FMainMemo, AFiles[0], True);
  4375. end;
  4376. procedure TMainForm.MemoZoom(Sender: TObject);
  4377. begin
  4378. if not FSynchingZoom then begin
  4379. FSynchingZoom := True;
  4380. try
  4381. for var Memo in FMemos do
  4382. if Memo <> Sender then
  4383. Memo.Zoom := (Sender as TScintEdit).Zoom;
  4384. finally
  4385. FSynchingZoom := False;
  4386. end;
  4387. end;
  4388. end;
  4389. procedure TMainForm.StatusBarResize(Sender: TObject);
  4390. begin
  4391. { Without this, on Windows XP with themes, the status bar's size grip gets
  4392. corrupted as the form is resized }
  4393. if StatusBar.HandleAllocated then
  4394. InvalidateRect(StatusBar.Handle, nil, True);
  4395. end;
  4396. procedure TMainForm.WMDebuggerQueryVersion(var Message: TMessage);
  4397. begin
  4398. Message.Result := LRESULT(FCompilerVersion.BinVersion);
  4399. end;
  4400. procedure TMainForm.WMDebuggerHello(var Message: TMessage);
  4401. var
  4402. PID: DWORD;
  4403. WantCodeText: Boolean;
  4404. begin
  4405. FDebugClientWnd := HWND(Message.WParam);
  4406. { Save debug client process handle }
  4407. if FDebugClientProcessHandle <> 0 then begin
  4408. { Shouldn't get here, but just in case, don't leak a handle }
  4409. CloseHandle(FDebugClientProcessHandle);
  4410. FDebugClientProcessHandle := 0;
  4411. end;
  4412. PID := 0;
  4413. if GetWindowThreadProcessId(FDebugClientWnd, @PID) <> 0 then
  4414. FDebugClientProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE,
  4415. False, PID);
  4416. WantCodeText := Bool(Message.LParam);
  4417. if WantCodeText then
  4418. SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeTextA, FCompiledCodeText);
  4419. SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeDebugInfoA, FCompiledCodeDebugInfo);
  4420. UpdateRunMenu;
  4421. end;
  4422. procedure TMainForm.WMDebuggerGoodbye(var Message: TMessage);
  4423. begin
  4424. ReplyMessage(0);
  4425. DebuggingStopped(True);
  4426. end;
  4427. procedure TMainForm.GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit; var DebugEntry: PDebugEntry);
  4428. function GetMemoFromDebugEntryFileIndex(const FileIndex: Integer): TIDEScintFileEdit;
  4429. var
  4430. Memo: TIDEScintFileEdit;
  4431. begin
  4432. Result := nil;
  4433. if FOptions.OpenIncludedFiles then begin
  4434. for Memo in FFileMemos do begin
  4435. if Memo.Used and (Memo.CompilerFileIndex = FileIndex) then begin
  4436. Result := Memo;
  4437. Exit;
  4438. end;
  4439. end;
  4440. end else if FMainMemo.CompilerFileIndex = FileIndex then
  4441. Result := FMainMemo;
  4442. end;
  4443. var
  4444. I: Integer;
  4445. begin
  4446. for I := 0 to FDebugEntriesCount-1 do begin
  4447. if (FDebugEntries[I].Kind = Kind) and (FDebugEntries[I].Index = Index) then begin
  4448. Memo := GetMemoFromDebugEntryFileIndex(FDebugEntries[I].FileIndex);
  4449. DebugEntry := @FDebugEntries[I];
  4450. Exit;
  4451. end;
  4452. end;
  4453. Memo := nil;
  4454. DebugEntry := nil;
  4455. end;
  4456. procedure TMainForm.BringToForeground;
  4457. { Brings our top window to the foreground. Called when pausing while
  4458. debugging. }
  4459. var
  4460. TopWindow: HWND;
  4461. begin
  4462. TopWindow := GetThreadTopWindow;
  4463. if TopWindow <> 0 then begin
  4464. { First ask the debug client to call SetForegroundWindow() on our window.
  4465. If we don't do this then Windows (98/2000+) will prevent our window from
  4466. becoming activated if the debug client is currently in the foreground. }
  4467. SendMessage(FDebugClientWnd, WM_DebugClient_SetForegroundWindow,
  4468. WPARAM(TopWindow), 0);
  4469. { Now call SetForegroundWindow() ourself. Why? When a remote thread calls
  4470. SetForegroundWindow(), the request is queued; the window doesn't actually
  4471. become active until the next time the window's thread checks the message
  4472. queue. This call causes the window to become active immediately. }
  4473. SetForegroundWindow(TopWindow);
  4474. end;
  4475. end;
  4476. procedure TMainForm.DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
  4477. var
  4478. Memo: TIDEScintFileEdit;
  4479. DebugEntry: PDebugEntry;
  4480. LineNumber: Integer;
  4481. begin
  4482. GetMemoAndDebugEntryFromMessage(Integer(Message.WParam), Integer(Message.LParam), Memo, DebugEntry);
  4483. if (Memo = nil) or (DebugEntry = nil) then
  4484. Exit;
  4485. LineNumber := DebugEntry.LineNumber;
  4486. if LineNumber < 0 then { UninstExe has a DebugEntry but not a line number }
  4487. Exit;
  4488. if (LineNumber < Memo.LineStateCount) and
  4489. (Memo.LineState[LineNumber] <> lnEntryProcessed) then begin
  4490. Memo.LineState[LineNumber] := lnEntryProcessed;
  4491. UpdateLineMarkers(Memo, LineNumber);
  4492. end;
  4493. if (FStepMode = smStepOut) and DebugEntry.StepOutMarker then
  4494. FStepMode := smStepInto { Pause on next line }
  4495. else if (FStepMode = smStepInto) or
  4496. ((FStepMode = smStepOver) and not Intermediate) or
  4497. ((FStepMode = smRunToCursor) and
  4498. (FRunToCursorPoint.Kind = Integer(Message.WParam)) and
  4499. (FRunToCursorPoint.Index = Message.LParam)) or
  4500. (Memo.BreakPoints.IndexOf(LineNumber) <> -1) then begin
  4501. MoveCaretAndActivateMemo(Memo, LineNumber, True);
  4502. HideError;
  4503. SetStepLine(Memo, LineNumber);
  4504. BringToForeground;
  4505. { Tell Setup to pause }
  4506. Message.Result := 1;
  4507. FPaused := True;
  4508. FPausedAtCodeLine := DebugEntry.Kind = Ord(deCodeLine);
  4509. UpdateRunMenu;
  4510. UpdateCaption;
  4511. end;
  4512. end;
  4513. procedure TMainForm.WMDebuggerStepped(var Message: TMessage);
  4514. begin
  4515. DebuggerStepped(Message, False);
  4516. end;
  4517. procedure TMainForm.WMDebuggerSteppedIntermediate(var Message: TMessage);
  4518. begin
  4519. DebuggerStepped(Message, True);
  4520. end;
  4521. procedure TMainForm.WMDPIChanged(var Message: TMessage);
  4522. begin
  4523. inherited;
  4524. for var Memo in FMemos do
  4525. Memo.DPIChanged(Message);
  4526. end;
  4527. procedure TMainForm.WMDebuggerException(var Message: TMessage);
  4528. var
  4529. Memo: TIDEScintFileEdit;
  4530. DebugEntry: PDebugEntry;
  4531. LineNumber: Integer;
  4532. S: String;
  4533. begin
  4534. if FOptions.PauseOnDebuggerExceptions then begin
  4535. GetMemoAndDebugEntryFromMessage(Integer(Message.WParam), Integer(Message.LParam), Memo, DebugEntry);
  4536. if DebugEntry <> nil then
  4537. LineNumber := DebugEntry.LineNumber
  4538. else
  4539. LineNumber := -1;
  4540. if (Memo <> nil) and (LineNumber >= 0) then begin
  4541. MoveCaretAndActivateMemo(Memo, LineNumber, True);
  4542. SetStepLine(Memo, -1);
  4543. SetErrorLine(Memo, LineNumber);
  4544. end;
  4545. BringToForeground;
  4546. { Tell Setup to pause }
  4547. Message.Result := 1;
  4548. FPaused := True;
  4549. FPausedAtCodeLine := (DebugEntry <> nil) and (DebugEntry.Kind = Ord(deCodeLine));
  4550. UpdateRunMenu;
  4551. UpdateCaption;
  4552. ReplyMessage(Message.Result); { so that Setup enters a paused state now }
  4553. if LineNumber >= 0 then begin
  4554. S := Format('Line %d:' + SNewLine + '%s', [LineNumber + 1, AddPeriod(FDebuggerException)]);
  4555. if (Memo <> nil) and (Memo.Filename <> '') then
  4556. S := Memo.Filename + SNewLine2 + S;
  4557. MsgBox(S, 'Runtime Error', mbCriticalError, mb_Ok)
  4558. end else
  4559. MsgBox(AddPeriod(FDebuggerException), 'Runtime Error', mbCriticalError, mb_Ok);
  4560. end;
  4561. end;
  4562. procedure TMainForm.WMDebuggerSetForegroundWindow(var Message: TMessage);
  4563. begin
  4564. SetForegroundWindow(HWND(Message.WParam));
  4565. end;
  4566. procedure TMainForm.WMDebuggerCallStackCount(var Message: TMessage);
  4567. begin
  4568. FCallStackCount := Cardinal(Message.WParam);
  4569. end;
  4570. procedure TMainForm.WMCopyData(var Message: TWMCopyData);
  4571. begin
  4572. const CopyDataMsg = DWORD(Message.CopyDataStruct.dwData);
  4573. case CopyDataMsg of
  4574. CD_Debugger_ReplyW: begin
  4575. FReplyString := '';
  4576. SetString(FReplyString, PChar(Message.CopyDataStruct.lpData),
  4577. Message.CopyDataStruct.cbData div SizeOf(Char));
  4578. Message.Result := 1;
  4579. end;
  4580. CD_Debugger_ExceptionW: begin
  4581. SetString(FDebuggerException, PChar(Message.CopyDataStruct.lpData),
  4582. Message.CopyDataStruct.cbData div SizeOf(Char));
  4583. Message.Result := 1;
  4584. end;
  4585. CD_Debugger_UninstExeW: begin
  4586. SetString(FUninstExe, PChar(Message.CopyDataStruct.lpData),
  4587. Message.CopyDataStruct.cbData div sizeOf(Char));
  4588. Message.Result := 1;
  4589. end;
  4590. CD_Debugger_LogMessageW: begin
  4591. var S: String;
  4592. SetString(S, PChar(Message.CopyDataStruct.lpData),
  4593. Message.CopyDataStruct.cbData div SizeOf(Char));
  4594. DebugLogMessage(S);
  4595. Message.Result := 1;
  4596. end;
  4597. CD_Debugger_TempDirW: begin
  4598. { Paranoia: Store it in a local variable first. That way, if there's
  4599. a problem reading the string FTempDir will be left unmodified.
  4600. Gotta be extra careful when storing a path we'll be deleting. }
  4601. var S: String;
  4602. SetString(S, PChar(Message.CopyDataStruct.lpData),
  4603. Message.CopyDataStruct.cbData div SizeOf(Char));
  4604. { Extreme paranoia: If there are any embedded nulls, discard it. }
  4605. if Pos(#0, S) <> 0 then
  4606. S := '';
  4607. FTempDir := S;
  4608. Message.Result := 1;
  4609. end;
  4610. CD_Debugger_CallStackW: begin
  4611. var S: String;
  4612. SetString(S, PChar(Message.CopyDataStruct.lpData),
  4613. Message.CopyDataStruct.cbData div SizeOf(Char));
  4614. DebugShowCallStack(S, FCallStackCount);
  4615. end;
  4616. end;
  4617. end;
  4618. function TMainForm.DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
  4619. begin
  4620. if Assigned(AMemo.LineState) then begin
  4621. AMemo.LineStateCapacity := 0;
  4622. AMemo.LineStateCount := 0;
  4623. FreeMem(AMemo.LineState);
  4624. AMemo.LineState := nil;
  4625. Result := True;
  4626. end else
  4627. Result := False;
  4628. end;
  4629. procedure TMainForm.DestroyDebugInfo;
  4630. var
  4631. HadDebugInfo: Boolean;
  4632. Memo: TIDEScintFileEdit;
  4633. begin
  4634. HadDebugInfo := False;
  4635. for Memo in FFileMemos do
  4636. if DestroyLineState(Memo) then
  4637. HadDebugInfo := True;
  4638. FDebugEntriesCount := 0;
  4639. FreeMem(FDebugEntries);
  4640. FDebugEntries := nil;
  4641. FVariableDebugEntriesCount := 0;
  4642. FreeMem(FVariableDebugEntries);
  4643. FVariableDebugEntries := nil;
  4644. FCompiledCodeText := '';
  4645. FCompiledCodeDebugInfo := '';
  4646. { Clear all dots and reset breakpoint icons (unless exiting; no point) }
  4647. if HadDebugInfo and not(csDestroying in ComponentState) then
  4648. UpdateAllMemosLineMarkers;
  4649. end;
  4650. var
  4651. PrevCompilerFileIndex: Integer;
  4652. PrevMemo: TIDEScintFileEdit;
  4653. procedure TMainForm.ParseDebugInfo(DebugInfo: Pointer);
  4654. function GetMemoFromCompilerFileIndex(const CompilerFileIndex: Integer): TIDEScintFileEdit;
  4655. var
  4656. Memo: TIDEScintFileEdit;
  4657. begin
  4658. if (PrevCompilerFileIndex <> CompilerFileIndex) then begin
  4659. PrevMemo := nil;
  4660. for Memo in FFileMemos do begin
  4661. if Memo.Used and (Memo.CompilerFileIndex = CompilerFileIndex) then begin
  4662. PrevMemo := Memo;
  4663. Break;
  4664. end;
  4665. end;
  4666. PrevCompilerFileIndex := CompilerFileIndex;
  4667. end;
  4668. Result := PrevMemo;
  4669. end;
  4670. { This creates and fills the DebugEntries and Memo LineState arrays }
  4671. var
  4672. Header: PDebugInfoHeader;
  4673. Memo: TIDEScintFileEdit;
  4674. I: Integer;
  4675. begin
  4676. DestroyDebugInfo;
  4677. Header := DebugInfo;
  4678. if (Header.ID <> DebugInfoHeaderID) or
  4679. (Header.Version <> DebugInfoHeaderVersion) then
  4680. raise Exception.Create('Unrecognized debug info format');
  4681. try
  4682. for Memo in FFileMemos do begin
  4683. if Memo.Used then begin
  4684. I := Memo.Lines.Count;
  4685. Memo.LineState := AllocMem(SizeOf(TLineState) * (I + LineStateGrowAmount));
  4686. Memo.LineStateCapacity := I + LineStateGrowAmount;
  4687. Memo.LineStateCount := I;
  4688. end;
  4689. end;
  4690. Inc(PByte(DebugInfo), SizeOf(Header^));
  4691. FDebugEntriesCount := Header.DebugEntryCount;
  4692. var Size := FDebugEntriesCount * SizeOf(TDebugEntry);
  4693. GetMem(FDebugEntries, Size);
  4694. Move(DebugInfo^, FDebugEntries^, Size);
  4695. for I := 0 to FDebugEntriesCount-1 do
  4696. Dec(FDebugEntries[I].LineNumber);
  4697. Inc(PByte(DebugInfo), Size);
  4698. FVariableDebugEntriesCount := Header.VariableDebugEntryCount;
  4699. Size := FVariableDebugEntriesCount * SizeOf(TVariableDebugEntry);
  4700. GetMem(FVariableDebugEntries, Size);
  4701. Move(DebugInfo^, FVariableDebugEntries^, Size);
  4702. Inc(PByte(DebugInfo), Size);
  4703. SetString(FCompiledCodeText, PAnsiChar(DebugInfo), Header.CompiledCodeTextLength);
  4704. Inc(PByte(DebugInfo), Header.CompiledCodeTextLength);
  4705. SetString(FCompiledCodeDebugInfo, PAnsiChar(DebugInfo), Header.CompiledCodeDebugInfoLength);
  4706. PrevCompilerFileIndex := UnknownCompilerFileIndex;
  4707. for I := 0 to FDebugEntriesCount-1 do begin
  4708. if FDebugEntries[I].LineNumber >= 0 then begin
  4709. Memo := GetMemoFromCompilerFileIndex(FDebugEntries[I].FileIndex);
  4710. if (Memo <> nil) and (FDebugEntries[I].LineNumber < Memo.LineStateCount) then begin
  4711. if Memo.LineState[FDebugEntries[I].LineNumber] = lnUnknown then
  4712. Memo.LineState[FDebugEntries[I].LineNumber] := lnHasEntry;
  4713. end;
  4714. end;
  4715. end;
  4716. UpdateAllMemosLineMarkers;
  4717. except
  4718. DestroyDebugInfo;
  4719. raise;
  4720. end;
  4721. end;
  4722. procedure TMainForm.ResetAllMemosLineState;
  4723. { Changes green dots back to grey dots }
  4724. var
  4725. Memo: TIDEScintFileEdit;
  4726. I: Integer;
  4727. begin
  4728. for Memo in FFileMemos do begin
  4729. if Memo.Used and Assigned(Memo.LineState) then begin
  4730. for I := 0 to Memo.LineStateCount-1 do begin
  4731. if Memo.LineState[I] = lnEntryProcessed then begin
  4732. Memo.LineState[I] := lnHasEntry;
  4733. UpdateLineMarkers(Memo, I);
  4734. end;
  4735. end;
  4736. end;
  4737. end;
  4738. end;
  4739. procedure TMainForm.CheckIfTerminated;
  4740. var
  4741. H: THandle;
  4742. begin
  4743. if FDebugging then begin
  4744. { Check if the process hosting the debug client (e.g. Setup or the
  4745. uninstaller second phase) has terminated. If the debug client hasn't
  4746. connected yet, check the initial process (e.g. SetupLdr or the
  4747. uninstaller first phase) instead. }
  4748. if FDebugClientWnd <> 0 then
  4749. H := FDebugClientProcessHandle
  4750. else
  4751. H := FProcessHandle;
  4752. if WaitForSingleObject(H, 0) <> WAIT_TIMEOUT then
  4753. DebuggingStopped(True);
  4754. end;
  4755. end;
  4756. procedure TMainForm.DebuggingStopped(const WaitForTermination: Boolean);
  4757. function GetExitCodeText: String;
  4758. var
  4759. ExitCode: DWORD;
  4760. begin
  4761. { Note: When debugging an uninstall, this will get the exit code off of
  4762. the first phase process, since that's the exit code users will see when
  4763. running the uninstaller outside the debugger. }
  4764. case WaitForSingleObject(FProcessHandle, 0) of
  4765. WAIT_OBJECT_0:
  4766. begin
  4767. if GetExitCodeProcess(FProcessHandle, ExitCode) then begin
  4768. { If the high bit is set, the process was killed uncleanly (e.g.
  4769. by a debugger). Show the exit code as hex in that case. }
  4770. if ExitCode and $80000000 <> 0 then
  4771. Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: 0x%.8x', [ExitCode])
  4772. else
  4773. Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: %u', [ExitCode]);
  4774. end
  4775. else
  4776. Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (GetExitCodeProcess failed)';
  4777. end;
  4778. WAIT_TIMEOUT:
  4779. Result := DebugTargetStrings[FDebugTarget] + ' is still running; can''t get exit code';
  4780. else
  4781. Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (WaitForSingleObject failed)';
  4782. end;
  4783. end;
  4784. var
  4785. ExitCodeText: String;
  4786. begin
  4787. if WaitForTermination then begin
  4788. { Give the initial process time to fully terminate so we can successfully
  4789. get its exit code }
  4790. WaitForSingleObject(FProcessHandle, 5000);
  4791. end;
  4792. FDebugging := False;
  4793. FDebugClientWnd := 0;
  4794. ExitCodeText := GetExitCodeText;
  4795. if FDebugClientProcessHandle <> 0 then begin
  4796. CloseHandle(FDebugClientProcessHandle);
  4797. FDebugClientProcessHandle := 0;
  4798. end;
  4799. CloseHandle(FProcessHandle);
  4800. FProcessHandle := 0;
  4801. FTempDir := '';
  4802. CheckIfTerminatedTimer.Enabled := False;
  4803. HideError;
  4804. SetStepLine(FStepMemo, -1);
  4805. UpdateRunMenu;
  4806. UpdateCaption;
  4807. DebugLogMessage('*** ' + ExitCodeText);
  4808. StatusBar.Panels[spExtraStatus].Text := ' ' + ExitCodeText;
  4809. end;
  4810. procedure TMainForm.DetachDebugger;
  4811. begin
  4812. CheckIfTerminated;
  4813. if not FDebugging then Exit;
  4814. SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Detach, 0, 0);
  4815. DebuggingStopped(False);
  4816. end;
  4817. function TMainForm.AskToDetachDebugger: Boolean;
  4818. begin
  4819. if FDebugClientWnd = 0 then begin
  4820. MsgBox('Please stop the running ' + DebugTargetStrings[FDebugTarget] + ' process before performing this command.',
  4821. SCompilerFormCaption, mbError, MB_OK);
  4822. Result := False;
  4823. end else if MsgBox('This command will detach the debugger from the running ' + DebugTargetStrings[FDebugTarget] + ' process. Continue?',
  4824. SCompilerFormCaption, mbError, MB_OKCANCEL) = IDOK then begin
  4825. DetachDebugger;
  4826. Result := True;
  4827. end else
  4828. Result := False;
  4829. end;
  4830. procedure TMainForm.RMenuClick(Sender: TObject);
  4831. begin
  4832. UpdateRunMenu2(RMenu);
  4833. end;
  4834. procedure TMainForm.BreakPointsPopupMenuClick(Sender: TObject);
  4835. begin
  4836. UpdateBreakPointsMenu(Sender as TMenuItem);
  4837. end;
  4838. procedure TMainForm.UpdateKeyMapping;
  4839. type
  4840. TKeyMappedMenu = TPair<TMenuItem, TPair<TShortcut, TToolButton>>;
  4841. function KMM(const MenuItem: TMenuItem; const DelphiKey: Word; const DelphiShift: TShiftState;
  4842. const VisualStudioKey: Word; const VisualStudioShift: TShiftState;
  4843. const ToolButton: TToolButton = nil): TKeyMappedMenu;
  4844. begin
  4845. var AShortCut: TShortCut;
  4846. case FOptions.KeyMappingType of
  4847. kmtDelphi: AShortCut := ShortCut(DelphiKey, DelphiShift);
  4848. kmtVisualStudio: AShortCut := ShortCut(VisualStudioKey, VisualStudioShift);
  4849. else
  4850. raise Exception.Create('Unknown FOptions.KeyMappingType');
  4851. end;
  4852. Result := TKeyMappedMenu.Create(MenuItem, TPair<TShortcut, TToolButton>.Create(AShortcut, ToolButton)); { These are records so no need to free }
  4853. end;
  4854. begin
  4855. var KeyMappedMenus := [
  4856. KMM(FPrint, Ord('P'), [ssCtrl], 0, []), { Also see EGotoFile below }
  4857. KMM(EFindRegEx, Ord('R'), [ssCtrl, ssAlt], Ord('R'), [ssAlt]),
  4858. KMM(EGotoFile, VK_F12, [ssCtrl], Ord('P'), [ssCtrl]), { Also see FPrint above }
  4859. KMM(BCompile, VK_F9, [ssCtrl], Ord('B'), [ssCtrl], CompileButton), { Also FCompileShortCut2 below }
  4860. KMM(RRun, VK_F9, [], VK_F5, [], RunButton),
  4861. KMM(RRunToCursor, VK_F4, [], VK_F10, [ssCtrl]),
  4862. KMM(RStepInto, VK_F7, [], VK_F11, []),
  4863. KMM(RStepOver, VK_F8, [], VK_F10, []),
  4864. KMM(RStepOut, VK_F8, [ssShift], VK_F11, [ssShift]),
  4865. KMM(RToggleBreakPoint, VK_F5, [], VK_F9, []),
  4866. KMM(RDeleteBreakPoints, VK_F5, [ssShift, ssCtrl], VK_F9, [ssShift, ssCtrl]),
  4867. KMM(RTerminate, VK_F2, [ssCtrl], VK_F5, [ssShift], TerminateButton),
  4868. KMM(REvaluate, VK_F7, [ssCtrl], VK_F9, [ssShift])];
  4869. FKeyMappedMenus.Clear;
  4870. for var KeyMappedMenu in KeyMappedMenus do begin
  4871. var ShortCut := KeyMappedMenu.Value.Key;
  4872. var ToolButton := KeyMappedMenu.Value.Value;
  4873. KeyMappedMenu.Key.ShortCut := ShortCut;
  4874. if ToolButton <> nil then begin
  4875. var MenuItem := KeyMappedMenu.Key;
  4876. ToolButton.Hint := Format('%s (%s)', [RemoveAccelChar(MenuItem.Caption), NewShortCutToText(ShortCut)]);
  4877. end;
  4878. FKeyMappedMenus.Add(ShortCut, ToolButton);
  4879. end;
  4880. { Set fake shortcuts on any duplicates of the above in popup menus }
  4881. SetFakeShortCut(RToggleBreakPoint2, RToggleBreakPoint.ShortCut);
  4882. SetFakeShortCut(RDeleteBreakPoints2, RDeleteBreakPoints.ShortCut);
  4883. { Handle three special cases:
  4884. -The Nav buttons have no corresponding menu item and also no ShortCut property
  4885. so they need special handling
  4886. -Visual Studio and Delphi have separate Compile and Build shortcuts and the
  4887. Compile shortcut is displayed by the menu and is set above but we want to
  4888. allow the Build shortcuts as well for our single Build/Compile command }
  4889. FBackNavButtonShortCut := ShortCut(VK_LEFT, [ssAlt]);
  4890. FForwardNavButtonShortCut := ShortCut(VK_RIGHT, [ssAlt]);
  4891. case FOptions.KeyMappingType of
  4892. kmtDelphi:
  4893. begin
  4894. FBackNavButtonShortCut2 := 0;
  4895. FForwardNavButtonShortCut2 := 0;
  4896. FCompileShortCut2 := ShortCut(VK_F9, [ssShift]);
  4897. end;
  4898. kmtVisualStudio:
  4899. begin
  4900. FBackNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl]);
  4901. FForwardNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl, ssShift]);
  4902. FCompileShortCut2 := ShortCut(VK_F7, []);
  4903. end;
  4904. else
  4905. raise Exception.Create('Unknown FOptions.KeyMappingType');
  4906. end;
  4907. BackNavButton.Hint := Format('Back (%s)', [NewShortCutToText(FBackNavButtonShortCut)]);
  4908. FKeyMappedMenus.Add(FBackNavButtonShortCut, nil);
  4909. ForwardNavButton.Hint := Format('Forward (%s)', [NewShortCutToText(FForwardNavButtonShortCut)]);
  4910. FKeyMappedMenus.Add(FForwardNavButtonShortCut, nil);
  4911. end;
  4912. procedure TMainForm.UpdateTheme;
  4913. procedure SetListBoxWindowTheme(const ListBox: TListBox);
  4914. begin
  4915. ListBox.Font.Color := FTheme.Colors[tcFore];
  4916. ListBox.Color := FTheme.Colors[tcBack];
  4917. ListBox.Invalidate;
  4918. SetControlWindowTheme(ListBox, FTheme.Dark);
  4919. end;
  4920. begin
  4921. FTheme.Typ := FOptions.ThemeType;
  4922. {$IF CompilerVersion >= 36.0 }
  4923. { For MainForm the active style only impacts message boxes and tooltips: FMemos, ToolbarPanel,
  4924. UpdatePanel, SplitPanel and the 4 ListBoxes all ignore it because their StyleName property is set
  4925. to 'Windows' always, either by the .dfm or by code. Additionally, for scrollbars and StatusBar,
  4926. MainForm's StyleElements is empty. Menus ignore it because shMenus is removed from
  4927. TStyleManager.SystemHooks at startup. }
  4928. if FTheme.Dark then
  4929. TStyleManager.TrySetStyle('Windows11 Modern Dark')
  4930. else
  4931. TStyleManager.TrySetStyle('Windows');
  4932. { For some reason only MainForm needs this: with StyleName set to an empty string, dialog boxes
  4933. it opens, such as MsgBox, look broken }
  4934. StyleName := TStyleManager.ActiveStyle.Name;
  4935. {$ENDIF}
  4936. if not Application.ShowMainForm then
  4937. Exit;
  4938. SetHelpFileDark(FTheme.Dark);
  4939. InitFormTheme(Self);
  4940. ToolbarPanel.Color := FTheme.Colors[tcToolBack];
  4941. for var Memo in FMemos do begin
  4942. Memo.UpdateThemeColorsAndStyleAttributes;
  4943. SetControlWindowTheme(Memo, FTheme.Dark);
  4944. end;
  4945. SetListBoxWindowTheme(CompilerOutputList);
  4946. SetListBoxWindowTheme(DebugOutputList);
  4947. SetListBoxWindowTheme(DebugCallStackList);
  4948. SetListBoxWindowTheme(FindResultsList);
  4949. ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.ToolBarImageCollection[FTheme.Dark];
  4950. ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.MarkersAndACImageCollection[FTheme.Dark];
  4951. UpdateThemeData(True);
  4952. UpdateBevel1Visibility;
  4953. UpdateMarginsAndAutoCompleteIcons;
  4954. SplitPanel.ParentBackground := False;
  4955. SplitPanel.Color := FTheme.Colors[tcSplitterBack];
  4956. FMenuDarkBackgroundBrush.Color := FTheme.Colors[tcToolBack];
  4957. FMenuDarkHotOrSelectedBrush.Color := $2C2C2C; { Same as themed menu drawn by Windows 11, which is close to Colors[tcBack] }
  4958. DrawMenuBar(Handle);
  4959. { SetPreferredAppMode doesn't work without FlushMenuThemes here: it would have
  4960. to be called before the form is created to have an effect without
  4961. FlushMenuThemes. So don't call SetPreferredAppMode if FlushMenuThemes is
  4962. missing. }
  4963. if Assigned(SetPreferredAppMode) and Assigned(FlushMenuThemes) then begin
  4964. FMenuImageList := ThemedToolbarVirtualImageList;
  4965. if FTheme.Dark then
  4966. SetPreferredAppMode(PAM_FORCEDARK)
  4967. else
  4968. SetPreferredAppMode(PAM_FORCELIGHT);
  4969. FlushMenuThemes;
  4970. end else
  4971. FMenuImageList := LightToolbarVirtualImageList;
  4972. end;
  4973. procedure TMainForm.UpdateThemeData(const Open: Boolean);
  4974. procedure CloseThemeDataIfNeeded(var ThemeData: HTHEME);
  4975. begin
  4976. if ThemeData <> 0 then begin
  4977. CloseThemeData(ThemeData);
  4978. ThemeData := 0;
  4979. end;
  4980. end;
  4981. begin
  4982. CloseThemeDataIfNeeded(FProgressThemeData);
  4983. CloseThemeDataIfNeeded(FMenuThemeData);
  4984. CloseThemeDataIfNeeded(FToolbarThemeData);
  4985. CloseThemeDataIfNeeded(FStatusBarThemeData);
  4986. if Open and UseThemes then begin
  4987. FProgressThemeData := OpenThemeData(Handle, 'Progress');
  4988. FMenuThemeData := OpenThemeData(Handle, 'Menu');
  4989. if FTheme.Dark then
  4990. FToolbarThemeData := OpenThemeData(Handle, 'DarkMode::Toolbar');
  4991. if FToolbarThemeData = 0 then
  4992. FToolbarThemeData := OpenThemeData(Handle, 'Toolbar');
  4993. FStatusBarThemeData := OpenThemeData(Handle, 'Status');
  4994. end;
  4995. end;
  4996. procedure TMainForm.UpdateUpdatePanel;
  4997. begin
  4998. UpdatePanel.Visible := FUpdatePanelMessages.Count > 0;
  4999. if UpdatePanel.Visible then begin
  5000. var MessageToShowIndex := FUpdatePanelMessages.Count-1;
  5001. UpdateLinkLabel.Tag := MessageToShowIndex;
  5002. UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg;
  5003. if not FHighContrastActive then
  5004. UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
  5005. if FUpdatePanelMessages[MessageToShowIndex].ConfigIdent.StartsWith('Purchase') then
  5006. FDonateImageMenuItem := HPurchase
  5007. else
  5008. FDonateImageMenuItem := HDonate;
  5009. UpdatePanelDonateBitBtn.Hint := RemoveAccelChar(FDonateImageMenuItem.Caption)
  5010. end;
  5011. UpdateBevel1Visibility;
  5012. end;
  5013. procedure TMainForm.CompileIfNecessary;
  5014. function UnopenedIncludedFileModifiedSinceLastCompile: Boolean;
  5015. var
  5016. IncludedFile: TIncludedFile;
  5017. NewTime: TFileTime;
  5018. begin
  5019. Result := False;
  5020. for IncludedFile in FIncludedFiles do begin
  5021. if (IncludedFile.Memo = nil) and IncludedFile.HasLastWriteTime and
  5022. GetLastWriteTimeOfFile(IncludedFile.Filename, @NewTime) and
  5023. (CompareFileTime(IncludedFile.LastWriteTime, NewTime) <> 0) then begin
  5024. Result := True;
  5025. Exit;
  5026. end;
  5027. end;
  5028. end;
  5029. begin
  5030. CheckIfTerminated;
  5031. { Display warning if the user modified the script while running - does not support unopened included files }
  5032. if FDebugging and FModifiedAnySinceLastCompileAndGo then begin
  5033. if MsgBox('The changes you made will not take effect until you ' +
  5034. 're-compile.' + SNewLine2 + 'Continue running anyway?',
  5035. SCompilerFormCaption, mbError, MB_YESNO) <> IDYES then
  5036. Abort;
  5037. FModifiedAnySinceLastCompileAndGo := False;
  5038. { The process may have terminated while the message box was up; check,
  5039. and if it has, we want to recompile below }
  5040. CheckIfTerminated;
  5041. end;
  5042. if not FDebugging and (FModifiedAnySinceLastCompile or UnopenedIncludedFileModifiedSinceLastCompile) then
  5043. CompileFile('', False);
  5044. end;
  5045. procedure TMainForm.Go(const AStepMode: TStepMode);
  5046. procedure StartProcess;
  5047. var
  5048. RunFilename, RunParameters, WorkingDir: String;
  5049. Info: TShellExecuteInfo;
  5050. SaveFocusWindow: HWND;
  5051. WindowList: Pointer;
  5052. ShellExecuteResult: BOOL;
  5053. ErrorCode: DWORD;
  5054. begin
  5055. if FDebugTarget = dtUninstall then begin
  5056. if FUninstExe = '' then
  5057. raise Exception.Create(SCompilerNeedUninstExe);
  5058. RunFilename := FUninstExe;
  5059. end else begin
  5060. if FCompiledExe = '' then
  5061. raise Exception.Create(SCompilerNeedCompiledExe);
  5062. RunFilename := FCompiledExe;
  5063. end;
  5064. { The UInt32 cast prevents sign extension }
  5065. RunParameters := Format('/DEBUGWND=$%x ', [UInt32(Handle)]) + FRunParameters;
  5066. ResetAllMemosLineState;
  5067. DebugOutputList.Clear;
  5068. SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  5069. DebugCallStackList.Clear;
  5070. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  5071. if not (OutputTabSet.TabIndex in [tiDebugOutput, tiDebugCallStack]) then
  5072. OutputTabSet.TabIndex := tiDebugOutput;
  5073. SetStatusPanelVisible(True);
  5074. FillChar(Info, SizeOf(Info), 0);
  5075. Info.cbSize := SizeOf(Info);
  5076. Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT or
  5077. SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOZONECHECKS;
  5078. Info.Wnd := Handle;
  5079. if FOptions.RunAsDifferentUser then
  5080. Info.lpVerb := 'runas'
  5081. else
  5082. Info.lpVerb := 'open';
  5083. Info.lpFile := PChar(RunFilename);
  5084. Info.lpParameters := PChar(RunParameters);
  5085. WorkingDir := PathExtractDir(RunFilename);
  5086. Info.lpDirectory := PChar(WorkingDir);
  5087. Info.nShow := SW_SHOWNORMAL;
  5088. { When the RunAsDifferentUser option is enabled, it's this process that
  5089. waits on the UAC dialog, not Setup(Ldr), so we need to disable windows to
  5090. prevent the user from clicking other things before the UAC dialog is
  5091. dismissed (which is definitely a possibility if the "Switch to the secure
  5092. desktop when prompting for elevation" setting is disabled in Group
  5093. Policy). }
  5094. SaveFocusWindow := GetFocus;
  5095. WindowList := DisableTaskWindows(Handle);
  5096. try
  5097. { Also temporarily remove the focus since a disabled window's children can
  5098. still receive keystrokes. This is needed if Windows doesn't switch to
  5099. the secure desktop immediately and instead shows a flashing taskbar
  5100. button that the user must click (which happened on Windows Vista; I'm
  5101. unable to reproduce it on Windows 11). }
  5102. Windows.SetFocus(0);
  5103. ShellExecuteResult := ShellExecuteEx(@Info);
  5104. ErrorCode := GetLastError;
  5105. finally
  5106. EnableTaskWindows(WindowList);
  5107. Windows.SetFocus(SaveFocusWindow);
  5108. end;
  5109. if not ShellExecuteResult then begin
  5110. { Don't display error message if user clicked Cancel at UAC dialog }
  5111. if ErrorCode = ERROR_CANCELLED then
  5112. Abort;
  5113. raise Exception.CreateFmt(SCompilerExecuteSetupError2, [RunFilename,
  5114. ErrorCode, Win32ErrorString(ErrorCode)]);
  5115. end;
  5116. FDebugging := True;
  5117. FPaused := False;
  5118. FProcessHandle := Info.hProcess;
  5119. CheckIfTerminatedTimer.Enabled := True;
  5120. UpdateRunMenu;
  5121. UpdateCaption;
  5122. DebugLogMessage('*** ' + DebugTargetStrings[FDebugTarget] + ' started');
  5123. end;
  5124. procedure ContinueProcessIfPaused(const AStepMode: TStepMode);
  5125. begin
  5126. if FPaused then begin
  5127. FPaused := False;
  5128. UpdateRunMenu;
  5129. UpdateCaption;
  5130. if DebugCallStackList.Items.Count > 0 then begin
  5131. DebugCallStackList.Clear;
  5132. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  5133. DebugCallStackList.Update;
  5134. end;
  5135. { Tell it to continue }
  5136. SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Continue,
  5137. WPARAM(Ord(AStepMode = smStepOver)), 0);
  5138. end;
  5139. end;
  5140. begin
  5141. CompileIfNecessary;
  5142. FStepMode := AStepMode;
  5143. HideError;
  5144. SetStepLine(FStepMemo, -1);
  5145. if FDebugging then
  5146. ContinueProcessIfPaused(AStepMode)
  5147. else
  5148. StartProcess;
  5149. end;
  5150. function TMainForm.EvaluateConstant(const S: String;
  5151. out Output: String): Integer;
  5152. begin
  5153. { This is about evaluating constants like 'app' and not [Code] variables }
  5154. FReplyString := '';
  5155. Result := Integer(SendCopyDataMessageStr(FDebugClientWnd, Handle,
  5156. CD_DebugClient_EvaluateConstantW, S));
  5157. if Result > 0 then
  5158. Output := FReplyString;
  5159. end;
  5160. function TMainForm.EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
  5161. out Output: String): Integer;
  5162. begin
  5163. FReplyString := '';
  5164. Result := Integer(SendCopyDataMessage(FDebugClientWnd, Handle, CD_DebugClient_EvaluateVariableEntry,
  5165. DebugEntry, SizeOf(DebugEntry^)));
  5166. if Result > 0 then
  5167. Output := FReplyString;
  5168. end;
  5169. procedure TMainForm.RRunClick(Sender: TObject);
  5170. begin
  5171. Go(smRun);
  5172. end;
  5173. procedure TMainForm.RParametersClick(Sender: TObject);
  5174. begin
  5175. ReadMRUParametersList;
  5176. InputQueryCombo('Run Parameters', 'Command line parameters for ' + DebugTargetStrings[dtSetup] +
  5177. ' and ' + DebugTargetStrings[dtUninstall] + ':', FRunParameters, FMRUParametersList);
  5178. if FRunParameters <> '' then
  5179. ModifyMRUParametersList(FRunParameters, True);
  5180. end;
  5181. procedure TMainForm.RPauseClick(Sender: TObject);
  5182. begin
  5183. if FDebugging and not FPaused then begin
  5184. if FStepMode <> smStepInto then begin
  5185. FStepMode := smStepInto;
  5186. UpdateCaption;
  5187. end
  5188. else
  5189. MsgBox('A pause is already pending.', SCompilerFormCaption, mbError,
  5190. MB_OK);
  5191. end;
  5192. end;
  5193. procedure TMainForm.RRunToCursorClick(Sender: TObject);
  5194. function GetDebugEntryFromMemoAndLineNumber(Memo: TIDEScintFileEdit; LineNumber: Integer;
  5195. var DebugEntry: TDebugEntry): Boolean;
  5196. var
  5197. I: Integer;
  5198. begin
  5199. Result := False;
  5200. for I := 0 to FDebugEntriesCount-1 do begin
  5201. if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
  5202. (FDebugEntries[I].LineNumber = LineNumber) then begin
  5203. DebugEntry := FDebugEntries[I];
  5204. Result := True;
  5205. Break;
  5206. end;
  5207. end;
  5208. end;
  5209. begin
  5210. CompileIfNecessary;
  5211. if not GetDebugEntryFromMemoAndLineNumber((FActiveMemo as TIDEScintFileEdit), FActiveMemo.CaretLine, FRunToCursorPoint) then begin
  5212. MsgBox('No code was generated for the current line.', SCompilerFormCaption,
  5213. mbError, MB_OK);
  5214. Exit;
  5215. end;
  5216. Go(smRunToCursor);
  5217. end;
  5218. procedure TMainForm.RStepIntoClick(Sender: TObject);
  5219. begin
  5220. Go(smStepInto);
  5221. end;
  5222. procedure TMainForm.RStepOutClick(Sender: TObject);
  5223. begin
  5224. if FPausedAtCodeLine then
  5225. Go(smStepOut)
  5226. else
  5227. Go(smStepInto);
  5228. end;
  5229. procedure TMainForm.RStepOverClick(Sender: TObject);
  5230. begin
  5231. Go(smStepOver);
  5232. end;
  5233. procedure TMainForm.RTerminateClick(Sender: TObject);
  5234. var
  5235. S, Dir: String;
  5236. begin
  5237. S := 'This will unconditionally terminate the running ' +
  5238. DebugTargetStrings[FDebugTarget] + ' process. Continue?';
  5239. if FDebugTarget = dtSetup then
  5240. S := S + #13#10#13#10'Note that if ' + DebugTargetStrings[FDebugTarget] + ' ' +
  5241. 'is currently in the installation phase, any changes made to the ' +
  5242. 'system thus far will not be undone, nor will uninstall data be written.';
  5243. if MsgBox(S, 'Terminate', mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDYES then
  5244. Exit;
  5245. CheckIfTerminated;
  5246. if FDebugging then begin
  5247. DebugLogMessage('*** Terminating process');
  5248. Win32Check(TerminateProcess(FDebugClientProcessHandle, 6));
  5249. if (WaitForSingleObject(FDebugClientProcessHandle, 5000) <> WAIT_TIMEOUT) and
  5250. (FTempDir <> '') then begin
  5251. Dir := FTempDir;
  5252. FTempDir := '';
  5253. DebugLogMessage('*** Removing left-over temporary directory: ' + Dir);
  5254. { Sleep for a bit to allow files to be unlocked by Windows,
  5255. otherwise it fails intermittently (with Hyper-Threading, at least) }
  5256. Sleep(50);
  5257. if not DeleteDirTree(Dir) and DirExists(Dir) then
  5258. DebugLogMessage('*** Failed to remove temporary directory');
  5259. end;
  5260. DebuggingStopped(True);
  5261. end;
  5262. end;
  5263. procedure TMainForm.REvaluateClick(Sender: TObject);
  5264. var
  5265. Output: String;
  5266. begin
  5267. if InputQuery('Evaluate', 'Constant to evaluate (e.g., "{app}"):',
  5268. FLastEvaluateConstantText) then begin
  5269. case EvaluateConstant(FLastEvaluateConstantText, Output) of
  5270. 1: MsgBox(Output, 'Evaluate Result', mbInformation, MB_OK);
  5271. 2: MsgBox(Output, 'Evaluate Error', mbError, MB_OK);
  5272. else
  5273. MsgBox('An unknown error occurred.', 'Evaluate Error', mbError, MB_OK);
  5274. end;
  5275. end;
  5276. end;
  5277. procedure TMainForm.CheckIfTerminatedTimerTimer(Sender: TObject);
  5278. begin
  5279. { In cases of normal Setup termination, we receive a WM_Debugger_Goodbye
  5280. message. But in case we don't get that, use a timer to periodically check
  5281. if the process is no longer running. }
  5282. CheckIfTerminated;
  5283. end;
  5284. procedure TMainForm.POutputListCopyClick(Sender: TObject);
  5285. var
  5286. ListBox: TListBox;
  5287. Text: String;
  5288. I: Integer;
  5289. begin
  5290. if CompilerOutputList.Visible then
  5291. ListBox := CompilerOutputList
  5292. else if DebugOutputList.Visible then
  5293. ListBox := DebugOutputList
  5294. else if DebugCallStackList.Visible then
  5295. ListBox := DebugCallStackList
  5296. else
  5297. ListBox := FindResultsList;
  5298. Text := '';
  5299. if ListBox.SelCount > 0 then begin
  5300. for I := 0 to ListBox.Items.Count-1 do begin
  5301. if ListBox.Selected[I] then begin
  5302. if Text <> '' then
  5303. Text := Text + SNewLine;
  5304. Text := Text + ListBox.Items[I];
  5305. end;
  5306. end;
  5307. end;
  5308. Clipboard.AsText := Text;
  5309. end;
  5310. procedure TMainForm.POutputListSelectAllClick(Sender: TObject);
  5311. var
  5312. ListBox: TListBox;
  5313. I: Integer;
  5314. begin
  5315. if CompilerOutputList.Visible then
  5316. ListBox := CompilerOutputList
  5317. else if DebugOutputList.Visible then
  5318. ListBox := DebugOutputList
  5319. else if DebugCallStackList.Visible then
  5320. ListBox := DebugCallStackList
  5321. else
  5322. ListBox := FindResultsList;
  5323. ListBox.Items.BeginUpdate;
  5324. try
  5325. for I := 0 to ListBox.Items.Count-1 do
  5326. ListBox.Selected[I] := True;
  5327. finally
  5328. ListBox.Items.EndUpdate;
  5329. end;
  5330. end;
  5331. procedure TMainForm.OutputListKeyDown(Sender: TObject; var Key: Word;
  5332. Shift: TShiftState);
  5333. begin
  5334. if Shift = [ssCtrl] then begin
  5335. if Key = Ord('C') then
  5336. POutputListCopyClick(Sender)
  5337. else if Key = Ord('A') then
  5338. POutputListSelectAllClick(Sender);
  5339. end;
  5340. end;
  5341. procedure TMainForm.AppOnIdle(Sender: TObject; var Done: Boolean);
  5342. begin
  5343. { For an explanation of this, see the comment where HandleMessage is called }
  5344. if FCompiling then
  5345. Done := False;
  5346. FBecameIdle := True;
  5347. end;
  5348. procedure TMainForm.EGotoFileClick(Sender: TObject);
  5349. begin
  5350. const GotoFileForm = TGotoFileForm.Create(Application);
  5351. try
  5352. const Files = TStringList.Create;
  5353. try
  5354. { Build file list }
  5355. Files.Add(FMainMemo.Filename);
  5356. for var IncludedFile in FIncludedFiles do
  5357. if IncludedFile.Memo <> nil then
  5358. Files.Add(IncludedFile.Filename);
  5359. if FPreprocessorOutputMemo.Used then
  5360. Files.Add(MemosTabSet.Tabs[MemoToTabIndex(FPreprocessorOutputMemo)]);
  5361. { Show form }
  5362. GotoFileForm.Files := Files;
  5363. if GotoFileForm.ShowModal = mrOK then begin
  5364. { Go to file }
  5365. const FileIndex = GotoFileForm.FileIndex;
  5366. var GotoMemo: TIDEScintEdit := nil;
  5367. if FileIndex = 0 then
  5368. GotoMemo := FMainMemo
  5369. else if FPreprocessorOutputMemo.Used and (FileIndex = Files.Count-1) then
  5370. GotoMemo := FPreprocessorOutputMemo
  5371. else begin
  5372. const HiddenFileIndex = FHiddenFiles.IndexOf(Files[FileIndex]);
  5373. if HiddenFileIndex <> -1 then
  5374. ReopenTabOrTabs(HiddenFileIndex, True) { This activates, so don't set GotoMemo }
  5375. else begin
  5376. for var Memo in FFileMemos do begin
  5377. if Memo.Used and PathSame(Memo.Filename, Files[FileIndex]) then begin
  5378. GotoMemo := Memo;
  5379. Break;
  5380. end;
  5381. end;
  5382. end;
  5383. end;
  5384. if GotoMemo <> nil then
  5385. MemosTabSet.TabIndex := MemoToTabIndex(GotoMemo);
  5386. end;
  5387. finally
  5388. Files.Free;
  5389. end;
  5390. finally
  5391. GotoFileForm.Free;
  5392. end;
  5393. end;
  5394. procedure TMainForm.EGotoLineClick(Sender: TObject);
  5395. var
  5396. S: String;
  5397. L: Integer;
  5398. begin
  5399. S := IntToStr(FActiveMemo.CaretLine + 1);
  5400. if InputQuery('Go to Line', 'Line number:', S) then begin
  5401. L := StrToIntDef(S, Low(L));
  5402. if L <> Low(L) then
  5403. FActiveMemo.CaretLine := L - 1;
  5404. end;
  5405. end;
  5406. procedure TMainForm.StatusBarClick(Sender: TObject);
  5407. begin
  5408. if MemosTabSet.Visible and FOptions.OpenIncludedFiles and (FHiddenFiles.Count > 0) then begin
  5409. var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
  5410. var X := StatusBar.ScreenToClient(Point).X;
  5411. var W := 0;
  5412. for var I := 0 to StatusBar.Panels.Count-1 do begin
  5413. Inc(W, StatusBar.Panels[I].Width);
  5414. if X < W then begin
  5415. if I = spHiddenFilesCount then
  5416. (MemosTabSet.PopupMenu as TMainFormPopupMenu).Popup(Point.X, Point.Y);
  5417. Break;
  5418. end else if I = spHiddenFilesCount then
  5419. Break;
  5420. end;
  5421. end;
  5422. end;
  5423. procedure TMainForm.StatusBarCanvasDrawPanel(Canvas: TCanvas;
  5424. Panel: TStatusPanel; const Rect: TRect);
  5425. const
  5426. TP_DROPDOWNBUTTONGLYPH = 7;
  5427. TS_NORMAL = 1;
  5428. begin
  5429. case Panel.Index of
  5430. spHiddenFilesCount:
  5431. if MemosTabSet.Visible and FOptions.OpenIncludedFiles and (FHiddenFiles.Count > 0) then begin
  5432. var RText := Rect;
  5433. if FToolbarThemeData <> 0 then begin
  5434. Dec(RText.Right, RText.Bottom - RText.Top);
  5435. var RGlyph := Rect;
  5436. RGlyph.Left := RText.Right; { RGlyph is now a square }
  5437. DrawThemeBackground(FToolbarThemeData, Canvas.Handle, TP_DROPDOWNBUTTONGLYPH, TS_NORMAL, RGlyph, nil);
  5438. end;
  5439. var Color: TColor := FTheme.Colors[tcFore];
  5440. const LStyle = TStyleManager.ActiveStyle;
  5441. if not LStyle.IsSystemStyle then begin
  5442. const Details = LStyle.GetElementDetails(tsPane);
  5443. LStyle.GetElementColor(Details, ecTextColor, Color);
  5444. end;
  5445. Canvas.Font.Color := Color;
  5446. var S := Format('Tabs closed: %d', [FHiddenFiles.Count]);
  5447. Canvas.TextRect(RText, S, [tfCenter]);
  5448. end;
  5449. spCompileIcon:
  5450. if FCompiling then begin
  5451. var BuildImageList := ImagesModule.BuildImageList[FTheme.Dark];
  5452. ImageList_Draw(BuildImageList.Handle, FBuildAnimationFrame, Canvas.Handle,
  5453. Rect.Left + ((Rect.Right - Rect.Left) - BuildImageList.Width) div 2,
  5454. Rect.Top + ((Rect.Bottom - Rect.Top) - BuildImageList.Height) div 2, ILD_NORMAL);
  5455. end;
  5456. spCompileProgress:
  5457. if FCompiling and (FProgressMax > 0) then begin
  5458. var R := Rect;
  5459. InflateRect(R, -2, -2);
  5460. var LStyle := StyleServices(Self);
  5461. if not LStyle.Enabled or LStyle.IsSystemStyle then
  5462. LStyle := nil;
  5463. if LStyle <> nil then begin
  5464. { See Vcl.ComCtrl's TProgressBarStyleHook.Paint, .PaintFrame, and .PaintBar }
  5465. var Details: TThemedElementDetails;
  5466. Details.Element := teProgress;
  5467. if LStyle.HasTransparentParts(Details) then
  5468. LStyle.DrawParentBackground(Handle, Canvas.Handle, Details, False, @R);
  5469. Details := LStyle.GetElementDetails(tpBar);
  5470. LStyle.DrawElement(Canvas.Handle, Details, R);
  5471. InflateRect(R, -1, -1);
  5472. const W = R.Width;
  5473. const Pos = Integer(Round(W * (FProgress / FProgressMax)));
  5474. var FillR := R;
  5475. FillR.Right := FillR.Left + Pos;
  5476. Details := LStyle.GetElementDetails(tpChunk);
  5477. LStyle.DrawElement(Canvas.Handle, Details, FillR);
  5478. end else if FProgressThemeData = 0 then begin
  5479. { Border }
  5480. Canvas.Pen.Color := clBtnShadow;
  5481. Canvas.Brush.Style := bsClear;
  5482. Canvas.Rectangle(R);
  5483. InflateRect(R, -1, -1);
  5484. { Filled part }
  5485. var SaveRight := R.Right;
  5486. R.Right := R.Left + Integer(MulDivInt64(FProgress, R.Right - R.Left,
  5487. FProgressMax));
  5488. Canvas.Brush.Color := clHighlight;
  5489. Canvas.FillRect(R);
  5490. { Unfilled part }
  5491. R.Left := R.Right;
  5492. R.Right := SaveRight;
  5493. Canvas.Brush.Color := clBtnFace;
  5494. Canvas.FillRect(R);
  5495. end else begin
  5496. DrawThemeBackground(FProgressThemeData, Canvas.Handle,
  5497. PP_BAR, 0, R, nil);
  5498. { PP_FILL drawing on Windows 11 (and probably 10) is bugged: when
  5499. the width of the green bar is less than ~25 pixels, the bar is
  5500. drawn over the left border. The same thing happens with
  5501. TProgressBar, so I don't think the API is being used incorrectly.
  5502. Work around the bug by passing a clipping rectangle that excludes
  5503. the left edge when running on Windows 10/11 only. (I don't know if
  5504. earlier versions need it, or if later versions will fix it.) }
  5505. var CR := R;
  5506. if (Win32MajorVersion = 10) and (Win32MinorVersion = 0) then
  5507. Inc(CR.Left); { does this need to be DPI-scaled? }
  5508. R.Right := R.Left + Integer(MulDivInt64(FProgress, R.Right - R.Left,
  5509. FProgressMax));
  5510. DrawThemeBackground(FProgressThemeData, Canvas.Handle,
  5511. PP_FILL, PBFS_NORMAL, R, @CR);
  5512. end;
  5513. end;
  5514. end;
  5515. end;
  5516. procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar;
  5517. Panel: TStatusPanel; const Rect: TRect);
  5518. begin
  5519. StatusBarCanvasDrawPanel(StatusBar.Canvas, Panel, Rect);
  5520. end;
  5521. procedure TMainForm.InvalidateStatusPanel(const Index: Integer);
  5522. var
  5523. R: TRect;
  5524. begin
  5525. { For some reason, the VCL doesn't offer a method for this... }
  5526. if SendMessage(StatusBar.Handle, SB_GETRECT, Index, LPARAM(@R)) <> 0 then begin
  5527. InflateRect(R, -1, -1);
  5528. InvalidateRect(StatusBar.Handle, @R, True);
  5529. end;
  5530. end;
  5531. procedure TMainForm.UpdateCompileStatusPanels(const AProgress,
  5532. AProgressMax: Cardinal; const ASecondsRemaining: Integer;
  5533. const ABytesCompressedPerSecond: Cardinal);
  5534. begin
  5535. var CurTick := GetTickCount;
  5536. var LastTick := FLastAnimationTick;
  5537. FLastAnimationTick := CurTick;
  5538. { Icon and text panels - updated every 500ms }
  5539. if CurTick div 500 <> LastTick div 500 then begin
  5540. InvalidateStatusPanel(spCompileIcon);
  5541. FBuildAnimationFrame := (FBuildAnimationFrame + 1) mod 4;
  5542. if ASecondsRemaining >= 0 then
  5543. StatusBar.Panels[spExtraStatus].Text := Format(
  5544. ' Estimated time remaining: %.2d%s%.2d%s%.2d Average KB/sec: %.0n',
  5545. [(ASecondsRemaining div 60) div 60, FormatSettings.TimeSeparator,
  5546. (ASecondsRemaining div 60) mod 60, FormatSettings.TimeSeparator,
  5547. ASecondsRemaining mod 60, ABytesCompressedPerSecond / 1024])
  5548. else
  5549. StatusBar.Panels[spExtraStatus].Text := '';
  5550. end;
  5551. { Progress panel and taskbar progress bar - updated every 100ms }
  5552. if (CurTick div 100 <> LastTick div 100) and
  5553. ((FProgress <> AProgress) or (FProgressMax <> AProgressMax)) then begin
  5554. FProgress := AProgress;
  5555. FProgressMax := AProgressMax;
  5556. InvalidateStatusPanel(spCompileProgress);
  5557. { The taskbar progress updates are slow (on Windows 11). Limiting the
  5558. range to 64 instead of 1024 improved compression KB/sec by about 4%
  5559. (9000 to 9400) when the rate limit above is disabled. }
  5560. var NewValue: Cardinal := 1; { must be at least 1 for progress bar to show }
  5561. if AProgressMax > 0 then begin
  5562. { Not using MulDiv here to avoid rounding up }
  5563. NewValue := (AProgress * 64) div AProgressMax;
  5564. if NewValue = 0 then
  5565. NewValue := 1;
  5566. end;
  5567. { Don't call the function if the value hasn't changed, just in case there's
  5568. a performance penalty. (There doesn't appear to be on Windows 11.) }
  5569. if FTaskbarProgressValue <> NewValue then begin
  5570. FTaskbarProgressValue := NewValue;
  5571. SetAppTaskbarProgressValue(NewValue, 64);
  5572. end;
  5573. end;
  5574. end;
  5575. procedure TMainForm.WMSettingChange(var Message: TMessage);
  5576. begin
  5577. inherited;
  5578. if (FTheme.Typ <> ttClassic) and IsWindows10 and (Message.LParam <> 0) and (StrIComp(PChar(Message.LParam), 'ImmersiveColorSet') = 0) then begin
  5579. FOptions.ThemeType := GetDefaultThemeType;
  5580. UpdateTheme;
  5581. end;
  5582. for var Memo in FMemos do
  5583. Memo.SettingChange(Message);
  5584. end;
  5585. procedure TMainForm.WMThemeChanged(var Message: TMessage);
  5586. begin
  5587. { Don't Run to Cursor into this function, it will interrupt up the theme change }
  5588. UpdateThemeData(True);
  5589. inherited;
  5590. end;
  5591. procedure TMainForm.WMUAHDrawMenu(var Message: TMessage);
  5592. begin
  5593. if FTheme.Dark then
  5594. UAHDrawMenu(PUAHMenu(Message.lParam))
  5595. else
  5596. inherited;
  5597. end;
  5598. procedure TMainForm.WMUAHDrawMenuItem(var Message: TMessage);
  5599. begin
  5600. if FTheme.Dark then
  5601. UAHDrawMenuItem(PUAHDrawMenuItem(Message.lParam))
  5602. else
  5603. inherited;
  5604. end;
  5605. procedure TMainForm.WMNCActivate(var Message: TMessage);
  5606. begin
  5607. inherited;
  5608. UAHDrawMenuBottomLine;
  5609. end;
  5610. procedure TMainForm.WMNCPaint(var Message: TMessage);
  5611. begin
  5612. inherited;
  5613. UAHDrawMenuBottomLine;
  5614. end;
  5615. procedure TMainForm.RTargetClick(Sender: TObject);
  5616. var
  5617. NewTarget: TDebugTarget;
  5618. begin
  5619. if (Sender = RTargetSetup) or (Sender = TargetSetupButton) then
  5620. NewTarget := dtSetup
  5621. else
  5622. NewTarget := dtUninstall;
  5623. if (FDebugTarget <> NewTarget) and (not FDebugging or AskToDetachDebugger) then
  5624. FDebugTarget := NewTarget;
  5625. { Update always even if the user decided not to switch so the states are restored }
  5626. UpdateTargetMenu;
  5627. end;
  5628. procedure TMainForm.AppOnActivate(Sender: TObject);
  5629. const
  5630. ReloadMessages: array[Boolean] of String = (
  5631. 'The %s file has been modified outside of the source editor.' + SNewLine2 +
  5632. 'Do you want to reload the file?',
  5633. 'The %s file has been modified outside of the source editor. Changes have ' +
  5634. 'also been made in the source editor.' + SNewLine2 + 'Do you want to ' +
  5635. 'reload the file and lose the changes made in the source editor?');
  5636. var
  5637. Memo: TIDEScintFileEdit;
  5638. NewTime: TFileTime;
  5639. Changed: Boolean;
  5640. begin
  5641. for Memo in FFileMemos do begin
  5642. if (Memo.Filename = '') or not Memo.Used then
  5643. Continue;
  5644. { See if the file has been modified outside the editor }
  5645. Changed := False;
  5646. if GetLastWriteTimeOfFile(Memo.Filename, @NewTime) then begin
  5647. if CompareFileTime(Memo.FileLastWriteTime, NewTime) <> 0 then begin
  5648. Memo.FileLastWriteTime := NewTime;
  5649. Changed := True;
  5650. end;
  5651. end;
  5652. { If it has been, offer to reload it }
  5653. if Changed then begin
  5654. if IsWindowEnabled(Handle) then begin
  5655. if (not Memo.Modified and FOptions.Autoreload) or
  5656. (MsgBox(Format(ReloadMessages[Memo.Modified], [Memo.Filename]),
  5657. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES) then
  5658. if ConfirmCloseFile(False) then begin
  5659. OpenFile(Memo, Memo.Filename, False, FOptions.UndoAfterReload);
  5660. if Memo = FMainMemo then
  5661. Break; { Reloading the main script will also reload all include files }
  5662. end;
  5663. end
  5664. else begin
  5665. { When a modal dialog is up, don't offer to reload the file. Probably
  5666. not a good idea since the dialog might be manipulating the file. }
  5667. MsgBox('The ' + Memo.Filename + ' file has been modified outside ' +
  5668. 'of the source editor. You might want to reload it.',
  5669. SCompilerFormCaption, mbInformation, MB_OK);
  5670. end;
  5671. end;
  5672. end;
  5673. end;
  5674. procedure TMainForm.CompilerOutputListDrawItem(Control: TWinControl;
  5675. Index: Integer; Rect: TRect; State: TOwnerDrawState);
  5676. const
  5677. ThemeColors: array [TStatusMessageKind] of TThemeColor = (tcGreen, tcFore, tcOrange, tcRed);
  5678. var
  5679. Canvas: TCanvas;
  5680. S: String;
  5681. StatusMessageKind: TStatusMessageKind;
  5682. begin
  5683. Canvas := CompilerOutputList.Canvas;
  5684. S := CompilerOutputList.Items[Index];
  5685. Canvas.FillRect(Rect);
  5686. Inc(Rect.Left, 2);
  5687. if FOptions.ColorizeCompilerOutput and not (odSelected in State) then begin
  5688. StatusMessageKind := TStatusMessageKind(CompilerOutputList.Items.Objects[Index]);
  5689. Canvas.Font.Color := FTheme.Colors[ThemeColors[StatusMessageKind]];
  5690. end;
  5691. Canvas.TextOut(Rect.Left, Rect.Top, S);
  5692. end;
  5693. procedure TMainForm.DebugOutputListDrawItem(Control: TWinControl;
  5694. Index: Integer; Rect: TRect; State: TOwnerDrawState);
  5695. var
  5696. Canvas: TCanvas;
  5697. S: String;
  5698. begin
  5699. Canvas := DebugOutputList.Canvas;
  5700. S := DebugOutputList.Items[Index];
  5701. Canvas.FillRect(Rect);
  5702. Inc(Rect.Left, 2);
  5703. if (S <> '') and (S[1] = #9) then
  5704. Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 2, Maxint))
  5705. else begin
  5706. if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin
  5707. { Draw lines that begin with '-- ' (like '-- File entry --') in bold }
  5708. Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
  5709. Canvas.Font.Style := [fsBold];
  5710. Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 18, Maxint));
  5711. end else
  5712. Canvas.TextOut(Rect.Left, Rect.Top, S);
  5713. end;
  5714. end;
  5715. procedure TMainForm.DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  5716. State: TOwnerDrawState);
  5717. var
  5718. Canvas: TCanvas;
  5719. S: String;
  5720. begin
  5721. Canvas := DebugCallStackList.Canvas;
  5722. S := DebugCallStackList.Items[Index];
  5723. Canvas.FillRect(Rect);
  5724. Inc(Rect.Left, 2);
  5725. Canvas.TextOut(Rect.Left, Rect.Top, S);
  5726. end;
  5727. procedure TMainForm.FindResultsListDblClick(Sender: TObject);
  5728. var
  5729. FindResult: TFindResult;
  5730. Memo: TIDEScintFileEdit;
  5731. I: Integer;
  5732. begin
  5733. I := FindResultsList.ItemIndex;
  5734. if I <> -1 then begin
  5735. FindResult := FindResultsList.Items.Objects[I] as TFindResult;
  5736. if FindResult <> nil then begin
  5737. for Memo in FFileMemos do begin
  5738. if Memo.Used and PathSame(Memo.Filename, FindResult.Filename) then begin
  5739. MoveCaretAndActivateMemo(Memo, FindResult.Line, True);
  5740. Memo.SelectAndEnsureVisible(FindResult.Range);
  5741. ActiveControl := Memo;
  5742. Exit;
  5743. end;
  5744. end;
  5745. MsgBox('File not opened.', SCompilerFormCaption, mbError, MB_OK);
  5746. end;
  5747. end;
  5748. end;
  5749. procedure TMainForm.FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  5750. State: TOwnerDrawState);
  5751. var
  5752. Canvas: TCanvas;
  5753. S, S2: String;
  5754. FindResult: TFindResult;
  5755. StartI, EndI: Integer;
  5756. SaveColor: TColor;
  5757. begin
  5758. Canvas := FindResultsList.Canvas;
  5759. S := FindResultsList.Items[Index];
  5760. FindResult := FindResultsList.Items.Objects[Index] as TFindResult;
  5761. Canvas.FillRect(Rect);
  5762. Inc(Rect.Left, 2);
  5763. if FindResult = nil then begin
  5764. Canvas.Font.Style := [fsBold];
  5765. Canvas.TextOut(Rect.Left, Rect.Top, S);
  5766. end else if not (odSelected in State) then begin
  5767. StartI := FindResult.Range.StartPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
  5768. EndI := FindResult.Range.EndPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
  5769. if StartI > 1 then begin
  5770. Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, StartI-1));
  5771. Rect.Left := Canvas.PenPos.X;
  5772. end;
  5773. SaveColor := Canvas.Brush.Color;
  5774. if FTheme.Dark then
  5775. Canvas.Brush.Color := FTheme.Colors[tcRed]
  5776. else
  5777. Canvas.Brush.Color := FTheme.Colors[tcSelBack];
  5778. S2 := Copy(S, StartI, EndI-StartI);
  5779. Rect.Right := Rect.Left + Canvas.TextWidth(S2);
  5780. Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2); { TextRect instead of TextOut to avoid a margin around the text }
  5781. if EndI <= Length(S) then begin
  5782. Canvas.Brush.Color := SaveColor;
  5783. S2 := Copy(S, EndI, MaxInt);
  5784. Rect.Left := Rect.Right;
  5785. Rect.Right := Rect.Left + Canvas.TextWidth(S2);
  5786. Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2);
  5787. end;
  5788. end else
  5789. Canvas.TextOut(Rect.Left, Rect.Top, S)
  5790. end;
  5791. procedure TMainForm.OutputTabSetClick(Sender: TObject);
  5792. begin
  5793. case OutputTabSet.TabIndex of
  5794. tiCompilerOutput:
  5795. begin
  5796. CompilerOutputList.BringToFront;
  5797. CompilerOutputList.Visible := True;
  5798. DebugOutputList.Visible := False;
  5799. DebugCallStackList.Visible := False;
  5800. FindResultsList.Visible := False;
  5801. end;
  5802. tiDebugOutput:
  5803. begin
  5804. DebugOutputList.BringToFront;
  5805. DebugOutputList.Visible := True;
  5806. CompilerOutputList.Visible := False;
  5807. DebugCallStackList.Visible := False;
  5808. FindResultsList.Visible := False;
  5809. end;
  5810. tiDebugCallStack:
  5811. begin
  5812. DebugCallStackList.BringToFront;
  5813. DebugCallStackList.Visible := True;
  5814. CompilerOutputList.Visible := False;
  5815. DebugOutputList.Visible := False;
  5816. FindResultsList.Visible := False;
  5817. end;
  5818. tiFindResults:
  5819. begin
  5820. FindResultsList.BringToFront;
  5821. FindResultsList.Visible := True;
  5822. CompilerOutputList.Visible := False;
  5823. DebugOutputList.Visible := False;
  5824. DebugCallStackList.Visible := False;
  5825. end;
  5826. end;
  5827. end;
  5828. procedure TMainForm.ToggleBreakPoint(Line: Integer);
  5829. var
  5830. Memo: TIDEScintFileEdit;
  5831. begin
  5832. Memo := FActiveMemo as TIDEScintFileEdit;
  5833. const I = Memo.BreakPoints.IndexOf(Line);
  5834. if I = -1 then
  5835. Memo.BreakPoints.Add(Line)
  5836. else
  5837. Memo.BreakPoints.Delete(I);
  5838. UpdateLineMarkers(Memo, Line);
  5839. BuildAndSaveBreakPointLines(Memo);
  5840. end;
  5841. procedure TMainForm.MemoMarginClick(Sender: TObject; MarginNumber: Integer;
  5842. Line: Integer);
  5843. begin
  5844. if (MarginNumber = 1) and RToggleBreakPoint.Enabled then
  5845. ToggleBreakPoint(Line);
  5846. end;
  5847. procedure TMainForm.MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
  5848. Line: Integer);
  5849. begin
  5850. if MarginNumber = 1 then begin
  5851. var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
  5852. var PopupMenu := TMainFormPopupMenu.Create(Self, BreakPointsPopupMenu);
  5853. try
  5854. PopupMenu.Popup(Point.X, Point.Y);
  5855. finally
  5856. PopupMenu.Free;
  5857. end;
  5858. end;
  5859. end;
  5860. procedure TMainForm.RToggleBreakPointClick(Sender: TObject);
  5861. begin
  5862. ToggleBreakPoint(FActiveMemo.CaretLine);
  5863. end;
  5864. procedure TMainForm.RDeleteBreakPointsClick(Sender: TObject);
  5865. begin
  5866. { Also see AnyMemoHasBreakPoint }
  5867. for var Memo in FFileMemos do begin
  5868. if Memo.Used and (Memo.BreakPoints.Count > 0) then begin
  5869. for var I := Memo.BreakPoints.Count-1 downto 0 do begin
  5870. var Line := Memo.BreakPoints[I];
  5871. Memo.BreakPoints.Delete(I);
  5872. UpdateLineMarkers(Memo, Line);
  5873. end;
  5874. BuildAndSaveBreakPointLines(Memo);
  5875. end;
  5876. end;
  5877. end;
  5878. procedure TMainForm.UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
  5879. var
  5880. NewMarker: Integer;
  5881. begin
  5882. if Line >= AMemo.Lines.Count then
  5883. Exit;
  5884. var StepLine := AMemo.StepLine = Line;
  5885. NewMarker := -1;
  5886. if AMemo.BreakPoints.IndexOf(Line) <> -1 then begin
  5887. if AMemo.LineState = nil then
  5888. NewMarker := mmiBreakpoint
  5889. else if (Line < AMemo.LineStateCount) and (AMemo.LineState[Line] <> lnUnknown) then
  5890. NewMarker := IfThen(StepLine, mmiBreakpointStep, mmiBreakpointGood)
  5891. else
  5892. NewMarker := mmiBreakpointBad;
  5893. end else if StepLine then
  5894. NewMarker := mmiStep
  5895. else begin
  5896. if Line < AMemo.LineStateCount then begin
  5897. case AMemo.LineState[Line] of
  5898. lnHasEntry: NewMarker := mmiHasEntry;
  5899. lnEntryProcessed: NewMarker := mmiEntryProcessed;
  5900. end;
  5901. end;
  5902. end;
  5903. { Delete all markers on the line. To flush out any possible duplicates,
  5904. even the markers we'll be adding next are deleted. }
  5905. if AMemo.GetMarkers(Line) <> [] then
  5906. AMemo.DeleteAllMarkersOnLine(Line);
  5907. if NewMarker <> -1 then
  5908. AMemo.AddMarker(Line, TScintMarkerNumber(NewMarker));
  5909. if StepLine then
  5910. AMemo.AddMarker(Line, mlmStep)
  5911. else if AMemo.ErrorLine = Line then
  5912. AMemo.AddMarker(Line, mlmError)
  5913. else if NewMarker = mmiBreakpointBad then
  5914. AMemo.AddMarker(Line, mlmBreakpointBad);
  5915. end;
  5916. procedure TMainForm.UpdateLinkLabelLinkClick(Sender: TObject;
  5917. const Link: string; LinkType: TSysLinkType);
  5918. begin
  5919. if LinkType <> sltID then
  5920. Exit;
  5921. if Link = 'fexit' then
  5922. FExit.Click
  5923. else if Link = 'hpurchase' then
  5924. HPurchase.Click
  5925. else if Link = 'hunregister' then
  5926. HUnregister.Click
  5927. else if Link = 'hwhatsnew' then
  5928. HWhatsNew.Click
  5929. else if Link = 'toptions-vscode' then begin
  5930. TOptionsForm.DropDownMemoKeyMappingComboBoxOnNextShow := True;
  5931. TOptions.Click
  5932. end else if Link = 'ideas' then
  5933. LaunchFileOrURL('https://ideas.innosetup.nl');
  5934. end;
  5935. procedure TMainForm.UpdatePanelCloseBitBtnClick(Sender: TObject);
  5936. begin
  5937. var MessageToHideIndex := UpdateLinkLabel.Tag;
  5938. var Ini := TConfigIniFile.Create;
  5939. try
  5940. Ini.WriteInteger('UpdatePanel', FUpdatePanelMessages[MessageToHideIndex].ConfigIdent, FUpdatePanelMessages[MessageToHideIndex].ConfigValue);
  5941. finally
  5942. Ini.Free;
  5943. end;
  5944. FUpdatePanelMessages.Delete(MessageToHideIndex);
  5945. UpdateUpdatePanel;
  5946. end;
  5947. procedure TMainForm.UpdatePanelDonateBitBtnClick(Sender: TObject);
  5948. begin
  5949. FDonateImageMenuItem.Click;
  5950. end;
  5951. procedure TMainForm.UpdatePanelCloseBitBtnPaint(Sender: TObject; Canvas: TCanvas; var ARect: TRect);
  5952. const
  5953. MENU_SYSTEMCLOSE = 17;
  5954. MSYSC_NORMAL = 1;
  5955. begin
  5956. var R := ARect;
  5957. if FMenuThemeData <> 0 then begin
  5958. var Offset := MulDiv(2, CurrentPPI, 96);
  5959. Inc(R.Left, Offset);
  5960. DrawThemeBackground(FMenuThemeData, Canvas.Handle, MENU_SYSTEMCLOSE, MSYSC_NORMAL, R, nil);
  5961. end else begin
  5962. InflateRect(R, -MulDiv(6, CurrentPPI, 96), -MulDiv(6, CurrentPPI, 96));
  5963. Canvas.Pen.Color := Canvas.Font.Color;
  5964. Canvas.MoveTo(R.Left, R.Top);
  5965. Canvas.LineTo(R.Right, R.Bottom);
  5966. Canvas.MoveTo(R.Left, R.Bottom-1);
  5967. Canvas.LineTo(R.Right, R.Top-1);
  5968. end;
  5969. end;
  5970. procedure TMainForm.UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
  5971. begin
  5972. for var Line := 0 to AMemo.Lines.Count-1 do
  5973. UpdateLineMarkers(AMemo, Line);
  5974. end;
  5975. procedure TMainForm.UpdateAllMemosLineMarkers;
  5976. begin
  5977. for var Memo in FFileMemos do
  5978. if Memo.Used then
  5979. UpdateAllMemoLineMarkers(Memo);
  5980. end;
  5981. procedure TMainForm.UpdateBevel1Visibility;
  5982. begin
  5983. { Bevel1 is the line between the toolbar and memos when there's nothing in
  5984. between and the color of the toolbar and memo margins is the same }
  5985. Bevel1.Visible := (ToolBarPanel.Color = FTheme.Colors[tcMarginBack]) and
  5986. not UpdatePanel.Visible and not MemosTabSet.Visible;
  5987. end;
  5988. initialization
  5989. Application.OnGetActiveFormHandle := TMainForm.AppOnGetActiveFormHandle;
  5990. InitThemeLibrary;
  5991. InitHtmlHelpLibrary;
  5992. { For ClearType support, try to make the default font Microsoft Sans Serif }
  5993. if DefFontData.Name = 'MS Sans Serif' then
  5994. DefFontData.Name := AnsiString(GetPreferredUIFont);
  5995. CoInitialize(nil);
  5996. finalization
  5997. CoUninitialize();
  5998. end.