IDE.MainForm.pas 239 KB

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