IDE.MainForm.pas 242 KB

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