IDE.MainForm.pas 301 KB

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