IDE.MainForm.pas 236 KB

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