IDE.MainForm.pas 240 KB

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