| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558 |
- unit IDE.MainForm;
- {
- Inno Setup
- Copyright (C) 1997-2025 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- Compiler form
- }
- {x$DEFINE STATICCOMPILER}
- { For debugging purposes, remove the 'x' to have it link the compiler code into
- this program and not depend on ISCmplr.dll. You will also need to add the
- ..\Components and Src folders to the Delphi Compiler Search path in the project
- options. Also see ISCC's STATICCOMPILER and Compiler.Compile's STATICPREPROC. }
- {$IFDEF STATICCOMPILER}
- {$R ..\Res\ISCmplr.images.res}
- {$ENDIF}
- interface
- uses
- Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms, Dialogs, CommDlg,
- Generics.Collections, UIStateForm, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, CommCtrl,
- ScintInt, ScintEdit, IDE.ScintStylerInnoSetup, NewTabSet, ModernColors, IDE.IDEScintEdit,
- Shared.DebugStruct, Shared.CompilerInt.Struct, NewUxTheme, ImageList, ImgList, ToolWin, IDE.HelperFunc,
- VirtualImageList, BaseImageCollection, BitmapButton;
- const
- WM_StartCommandLineCompile = WM_USER + $1000;
- WM_StartCommandLineWizard = WM_USER + $1001;
- WM_StartNormally = WM_USER + $1002;
- type
- PDebugEntryArray = ^TDebugEntryArray;
- TDebugEntryArray = array[0..0] of TDebugEntry;
- PVariableDebugEntryArray = ^TVariableDebugEntryArray;
- TVariableDebugEntryArray = array[0..0] of TVariableDebugEntry;
- TStepMode = (smRun, smStepInto, smStepOver, smStepOut, smRunToCursor);
- TDebugTarget = (dtSetup, dtUninstall);
- const
- DebugTargetStrings: array[TDebugTarget] of String = ('Setup', 'Uninstall');
- const
- MRUListMaxCount = 10;
- { Status bar panel indexes }
- spCaretPos = 0;
- spModified = 1;
- spEditMode = 2;
- spFindRegEx = 3;
- spHiddenFilesCount = 4;
- spCompileIcon = 5;
- spCompileProgress = 6;
- spExtraStatus = 7;
- { Output tab set indexes }
- tiCompilerOutput = 0;
- tiDebugOutput = 1;
- tiDebugCallStack = 2;
- tiFindResults = 3;
- type
- TStatusMessageKind = (smkStartEnd, smkNormal, smkWarning, smkError);
- TIncludedFile = class
- Filename: String;
- CompilerFileIndex: Integer;
- LastWriteTime: TFileTime;
- HasLastWriteTime: Boolean;
- Memo: TIDEScintFileEdit;
- end;
- TIncludedFiles = TObjectList<TIncludedFile>;
- TFindResult = class
- Filename: String;
- Line, LineStartPos: Integer;
- Range: TScintRange;
- PrefixStringLength: Integer;
- end;
- TFindResults = TObjectList<TFindResult>;
- TMenuBitmaps = TDictionary<TMenuItem, HBITMAP>;
- TKeyMappedMenus = TDictionary<TShortCut, TToolButton>;
- TCallTipState = record
- StartCallTipWord: Integer;
- FunctionDefinition: AnsiString;
- BraceCount: Integer;
- LastPosCallTip: Integer;
- ClassOrRecordMember: Boolean;
- CurrentCallTipWord: String;
- CurrentCallTip: Integer;
- MaxCallTips: Integer;
- end;
- TUpdatePanelMessage = class
- Msg, ConfigIdent: String;
- ConfigValue: Integer;
- Color: TColor;
- HasLink: Boolean;
- constructor Create(const AMsg, AConfigIdent: String; const AConfigValue: Integer; const AColor: TColor; const AHasLink: Boolean);
- end;
- TUpdatePanelMessages = TObjectList<TUpdatePanelMessage>;
- TOptions = record
- ShowStartupForm: Boolean;
- UseWizard: Boolean;
- Autosave: Boolean;
- Autoreload: Boolean;
- MakeBackups: Boolean;
- FullPathInTitleBar: Boolean;
- UndoAfterSave: Boolean;
- UndoAfterReload: Boolean;
- PauseOnDebuggerExceptions: Boolean;
- RunAsDifferentUser: Boolean;
- AutoAutoComplete: Boolean;
- AutoCallTips: Boolean;
- UseSyntaxHighlighting: Boolean;
- ColorizeCompilerOutput: Boolean;
- UnderlineErrors: Boolean;
- HighlightWordAtCursorOccurrences: Boolean;
- HighlightSelTextOccurrences: Boolean;
- CursorPastEOL: Boolean;
- TabWidth: Integer;
- UseTabCharacter: Boolean;
- ShowWhiteSpace: Boolean;
- UseFolding: Boolean;
- FindRegEx: Boolean;
- WordWrap: Boolean;
- AutoIndent: Boolean;
- IndentationGuides: Boolean;
- LowPriorityDuringCompile: Boolean;
- GutterLineNumbers: Boolean;
- KeyMappingType: TKeyMappingType;
- MemoKeyMappingType: TIDEScintKeyMappingType;
- ThemeType: TThemeType;
- ShowPreprocessorOutput: Boolean;
- OpenIncludedFiles: Boolean;
- AutoHideNewIncludedFiles: Boolean;
- ShowCaretPosition: Boolean;
- end;
- TMainForm = class(TUIStateForm)
- MainMenu1: TMainMenu;
- FMenu: TMenuItem;
- FNewMainFile: TMenuItem;
- FOpenMainFile: TMenuItem;
- FSave: TMenuItem;
- FSaveMainFileAs: TMenuItem;
- N1: TMenuItem;
- BCompile: TMenuItem;
- N2: TMenuItem;
- FExit: TMenuItem;
- EMenu: TMenuItem;
- EUndo: TMenuItem;
- N3: TMenuItem;
- ECut: TMenuItem;
- ECopy: TMenuItem;
- EPaste: TMenuItem;
- EDelete: TMenuItem;
- N4: TMenuItem;
- ESelectAll: TMenuItem;
- VMenu: TMenuItem;
- EFind: TMenuItem;
- EFindNext: TMenuItem;
- EReplace: TMenuItem;
- HMenu: TMenuItem;
- HDoc: TMenuItem;
- HAbout: TMenuItem;
- FRecent: TMenuItem;
- FClearRecent: TMenuItem;
- N6: TMenuItem;
- VCompilerOutput: TMenuItem;
- FindDialog: TFindDialog;
- ReplaceDialog: TReplaceDialog;
- StatusPanel: TPanel;
- CompilerOutputList: TListBox;
- SplitPanel: TPanel;
- HWebsite: TMenuItem;
- VToolbar: TMenuItem;
- N7: TMenuItem;
- TOptions: TMenuItem;
- HFaq: TMenuItem;
- StatusBar: TStatusBar;
- BodyPanel: TPanel;
- VStatusBar: TMenuItem;
- ERedo: TMenuItem;
- RMenu: TMenuItem;
- RStepInto: TMenuItem;
- RStepOver: TMenuItem;
- N5: TMenuItem;
- RRun: TMenuItem;
- RRunToCursor: TMenuItem;
- N10: TMenuItem;
- REvaluate: TMenuItem;
- CheckIfTerminatedTimer: TTimer;
- RPause: TMenuItem;
- RParameters: TMenuItem;
- OutputListPopupMenu: TMenuItem;
- POutputListCopy: TMenuItem;
- HISPPSep: TMenuItem;
- N12: TMenuItem;
- BStopCompile: TMenuItem;
- HISPPDoc: TMenuItem;
- N13: TMenuItem;
- EGotoLine: TMenuItem;
- RTerminate: TMenuItem;
- BMenu: TMenuItem;
- BLowPriority: TMenuItem;
- HPurchase: TMenuItem;
- HRegister: TMenuItem;
- HUnregister: TMenuItem;
- HDonate: TMenuItem;
- N14: TMenuItem;
- N15: TMenuItem;
- RTargetSetup: TMenuItem;
- RTargetUninstall: TMenuItem;
- OutputTabSet: TNewTabSet;
- DebugOutputList: TListBox;
- VDebugOutput: TMenuItem;
- VHide: TMenuItem;
- N11: TMenuItem;
- TMenu: TMenuItem;
- TAddRemovePrograms: TMenuItem;
- RToggleBreakPoint: TMenuItem;
- RDeleteBreakPoints: TMenuItem;
- HWhatsNew: TMenuItem;
- TGenerateGUID: TMenuItem;
- TSignTools: TMenuItem;
- N16: TMenuItem;
- HExamples: TMenuItem;
- N17: TMenuItem;
- BOpenOutputFolder: TMenuItem;
- N8: TMenuItem;
- VZoom: TMenuItem;
- VZoomIn: TMenuItem;
- VZoomOut: TMenuItem;
- N9: TMenuItem;
- VZoomReset: TMenuItem;
- N18: TMenuItem;
- N19: TMenuItem;
- FSaveEncoding: TMenuItem;
- FSaveEncodingAuto: TMenuItem;
- FSaveEncodingUTF8WithBOM: TMenuItem;
- ToolBar: TToolBar;
- BackNavButton: TToolButton;
- ForwardNavButton: TToolButton;
- ToolButton1: TToolButton;
- NewMainFileButton: TToolButton;
- OpenMainFileButton: TToolButton;
- SaveButton: TToolButton;
- ToolButton2: TToolButton;
- CompileButton: TToolButton;
- StopCompileButton: TToolButton;
- ToolButton3: TToolButton;
- RunButton: TToolButton;
- PauseButton: TToolButton;
- ToolButton4: TToolButton;
- TargetSetupButton: TToolButton;
- TargetUninstallButton: TToolButton;
- ToolButton5: TToolButton;
- HelpButton: TToolButton;
- Bevel1: TBevel;
- TerminateButton: TToolButton;
- ThemedToolbarVirtualImageList: TVirtualImageList;
- LightToolbarVirtualImageList: TVirtualImageList;
- POutputListSelectAll: TMenuItem;
- DebugCallStackList: TListBox;
- VDebugCallStack: TMenuItem;
- TMsgBoxDesigner: TMenuItem;
- TRegistryDesigner: TMenuItem;
- ToolBarPanel: TPanel;
- HMailingList: TMenuItem;
- MemosTabSet: TNewTabSet; { First tab is the main memo, last tab is the preprocessor output memo }
- FSaveAll: TMenuItem;
- RStepOut: TMenuItem;
- VNextTab: TMenuItem;
- VPreviousTab: TMenuItem;
- N20: TMenuItem;
- HShortcutsDoc: TMenuItem;
- HRegExDoc: TMenuItem;
- N21: TMenuItem;
- EFindPrevious: TMenuItem;
- FindResultsList: TListBox;
- VFindResults: TMenuItem;
- EFindInFiles: TMenuItem;
- FindInFilesDialog: TFindDialog;
- FPrint: TMenuItem;
- N22: TMenuItem;
- PrintDialog: TPrintDialog;
- FSaveEncodingUTF8WithoutBOM: TMenuItem;
- TFilesDesigner: TMenuItem;
- VCloseCurrentTab: TMenuItem;
- VReopenTab: TMenuItem;
- VReopenTabs: TMenuItem;
- MemosTabSetPopupMenu: TMenuItem;
- VCloseCurrentTab2: TMenuItem;
- VReopenTab2: TMenuItem;
- VReopenTabs2: TMenuItem;
- NavPopupMenu: TMenuItem;
- N23: TMenuItem;
- ThemedMarkersAndACVirtualImageList: TVirtualImageList;
- ESelectNextOccurrence: TMenuItem;
- ESelectAllOccurrences: TMenuItem;
- BreakPointsPopupMenu: TMenuItem;
- RToggleBreakPoint2: TMenuItem;
- RDeleteBreakPoints2: TMenuItem;
- N24: TMenuItem;
- VWordWrap: TMenuItem;
- N25: TMenuItem;
- ESelectAllFindMatches: TMenuItem;
- EToggleLinesComment: TMenuItem;
- EBraceMatch: TMenuItem;
- EFoldLine: TMenuItem;
- EUnfoldLine: TMenuItem;
- EFindRegEx: TMenuItem;
- UpdatePanel: TPanel;
- UpdateLinkLabel: TLinkLabel;
- UpdatePanelCloseBitBtn: TBitmapButton;
- UpdatePanelDonateBitBtn: TBitmapButton;
- EGotoFile: TMenuItem;
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure FExitClick(Sender: TObject);
- procedure FOpenMainFileClick(Sender: TObject);
- procedure EUndoClick(Sender: TObject);
- procedure EMenuClick(Sender: TObject);
- procedure ECutClick(Sender: TObject);
- procedure ECopyClick(Sender: TObject);
- procedure EPasteClick(Sender: TObject);
- procedure EDeleteClick(Sender: TObject);
- procedure FSaveClick(Sender: TObject);
- procedure ESelectAllClick(Sender: TObject);
- procedure FNewMainFileClick(Sender: TObject);
- procedure FNewMainFileUserWizardClick(Sender: TObject);
- procedure HDocClick(Sender: TObject);
- procedure BCompileClick(Sender: TObject);
- procedure FMenuClick(Sender: TObject);
- procedure FMRUClick(Sender: TObject);
- procedure VCompilerOutputClick(Sender: TObject);
- procedure HAboutClick(Sender: TObject);
- procedure EFindClick(Sender: TObject);
- procedure FindDialogFind(Sender: TObject);
- procedure EReplaceClick(Sender: TObject);
- procedure ReplaceDialogReplace(Sender: TObject);
- procedure EFindNextOrPreviousClick(Sender: TObject);
- procedure SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
- Y: Integer);
- procedure VMenuClick(Sender: TObject);
- procedure HWebsiteClick(Sender: TObject);
- procedure VToolbarClick(Sender: TObject);
- procedure TOptionsClick(Sender: TObject);
- procedure HFaqClick(Sender: TObject);
- procedure HISPPDocClick(Sender: TObject);
- procedure VStatusBarClick(Sender: TObject);
- procedure ERedoClick(Sender: TObject);
- procedure StatusBarResize(Sender: TObject);
- procedure RStepIntoClick(Sender: TObject);
- procedure RStepOverClick(Sender: TObject);
- procedure RRunToCursorClick(Sender: TObject);
- procedure RRunClick(Sender: TObject);
- procedure REvaluateClick(Sender: TObject);
- procedure CheckIfTerminatedTimerTimer(Sender: TObject);
- procedure RPauseClick(Sender: TObject);
- procedure RParametersClick(Sender: TObject);
- procedure POutputListCopyClick(Sender: TObject);
- procedure BStopCompileClick(Sender: TObject);
- procedure EGotoLineClick(Sender: TObject);
- procedure RTerminateClick(Sender: TObject);
- procedure BMenuClick(Sender: TObject);
- procedure BLowPriorityClick(Sender: TObject);
- procedure StatusBarDrawPanel(StatusBar: TStatusBar;
- Panel: TStatusPanel; const Rect: TRect);
- procedure HPurchaseClick(Sender: TObject);
- procedure HRegisterClick(Sender: TObject);
- procedure HUnregisterClick(Sender: TObject);
- procedure HDonateClick(Sender: TObject);
- procedure RTargetClick(Sender: TObject);
- procedure DebugOutputListDrawItem(Control: TWinControl; Index: Integer;
- Rect: TRect; State: TOwnerDrawState);
- procedure OutputTabSetClick(Sender: TObject);
- procedure VHideClick(Sender: TObject);
- procedure VDebugOutputClick(Sender: TObject);
- procedure FormResize(Sender: TObject);
- procedure TAddRemoveProgramsClick(Sender: TObject);
- procedure RToggleBreakPointClick(Sender: TObject);
- procedure RDeleteBreakPointsClick(Sender: TObject);
- procedure HWhatsNewClick(Sender: TObject);
- procedure TGenerateGUIDClick(Sender: TObject);
- procedure TSignToolsClick(Sender: TObject);
- procedure HExamplesClick(Sender: TObject);
- procedure BOpenOutputFolderClick(Sender: TObject);
- procedure FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure VZoomInClick(Sender: TObject);
- procedure VZoomOutClick(Sender: TObject);
- procedure VZoomResetClick(Sender: TObject);
- procedure FSaveEncodingItemClick(Sender: TObject);
- procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer;
- Rect: TRect; State: TOwnerDrawState);
- procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
- NewDPI: Integer);
- procedure POutputListSelectAllClick(Sender: TObject);
- procedure DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- procedure VDebugCallStackClick(Sender: TObject);
- procedure HMailingListClick(Sender: TObject);
- procedure TMsgBoxDesignerClick(Sender: TObject);
- procedure TRegistryDesignerClick(Sender: TObject);
- procedure MemosTabSetClick(Sender: TObject);
- procedure FSaveAllClick(Sender: TObject);
- procedure RStepOutClick(Sender: TObject);
- procedure TMenuClick(Sender: TObject);
- procedure VNextTabClick(Sender: TObject);
- procedure VPreviousTabClick(Sender: TObject);
- procedure HShortcutsDocClick(Sender: TObject);
- procedure HRegExDocClick(Sender: TObject);
- procedure VFindResultsClick(Sender: TObject);
- procedure EFindInFilesClick(Sender: TObject);
- procedure FindInFilesDialogFind(Sender: TObject);
- procedure FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- procedure FindResultsListDblClick(Sender: TObject);
- procedure FPrintClick(Sender: TObject);
- procedure TFilesDesignerClick(Sender: TObject);
- procedure VCloseCurrentTabClick(Sender: TObject);
- procedure VReopenTabsClick(Sender: TObject);
- procedure MemosTabSetPopupMenuClick(Sender: TObject);
- procedure MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
- procedure StatusBarClick(Sender: TObject);
- procedure SimpleMenuClick(Sender: TObject);
- procedure OutputListKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure RMenuClick(Sender: TObject);
- procedure BackNavButtonClick(Sender: TObject);
- procedure ForwardNavButtonClick(Sender: TObject);
- procedure NavPopupMenuClick(Sender: TObject);
- procedure ESelectNextOccurrenceClick(Sender: TObject);
- procedure ESelectAllOccurrencesClick(Sender: TObject);
- procedure BreakPointsPopupMenuClick(Sender: TObject);
- procedure FClearRecentClick(Sender: TObject);
- procedure VWordWrapClick(Sender: TObject);
- procedure ESelectAllFindMatchesClick(Sender: TObject);
- procedure EToggleLinesCommentClick(Sender: TObject);
- procedure EBraceMatchClick(Sender: TObject);
- procedure EFoldOrUnfoldLineClick(Sender: TObject);
- procedure EFindRegExClick(Sender: TObject);
- procedure UpdateLinkLabelLinkClick(Sender: TObject; const Link: string;
- LinkType: TSysLinkType);
- procedure UpdatePanelCloseBitBtnPaint(Sender: TObject; Canvas: TCanvas; var ARect: TRect);
- procedure UpdatePanelCloseBitBtnClick(Sender: TObject);
- procedure UpdatePanelDonateBitBtnClick(Sender: TObject);
- procedure HMenuClick(Sender: TObject);
- procedure EGotoFileClick(Sender: TObject);
- private
- FCompilerVersion: PCompilerVersionInfo;
- FOptionsLoaded: Boolean;
- FCompileWantAbort: Boolean;
- FBecameIdle: Boolean;
- FModifiedAnySinceLastCompile, FModifiedAnySinceLastCompileAndGo: Boolean;
- FDebugEntries: PDebugEntryArray;
- FDebugEntriesCount: Integer;
- FVariableDebugEntries: PVariableDebugEntryArray;
- FVariableDebugEntriesCount: Integer;
- FCompiledCodeText: AnsiString;
- FCompiledCodeDebugInfo: AnsiString;
- FProcessHandle, FDebugClientProcessHandle: THandle;
- FUninstExe, FTempDir: String;
- FPreprocessorOutput: String;
- FIncludedFiles: TIncludedFiles;
- FStepMode: TStepMode;
- FPausedAtCodeLine: Boolean;
- FRunToCursorPoint: TDebugEntry;
- FReplyString: String;
- FDebuggerException: String;
- FRunParameters: String;
- FLastEvaluateConstantText: String;
- FSavePriorityClass: DWORD;
- FBuildAnimationFrame: Cardinal;
- FLastAnimationTick: DWORD;
- FProgress, FProgressMax: Cardinal;
- FTaskbarProgressValue: Cardinal;
- FProgressThemeData: HTHEME;
- FToolbarThemeData: HTHEME;
- FStatusBarThemeData: HTHEME;
- FDebugLogListTimestampsWidth: Integer;
- FOnPendingSquiggly: Boolean;
- FPendingSquigglyCaretPos: Integer;
- FCallStackCount: Cardinal;
- FDevMode, FDevNames: HGLOBAL;
- FSynchingZoom: Boolean;
- FKeyMappedMenus: TKeyMappedMenus;
- FBackNavButtonShortCut, FForwardNavButtonShortCut: TShortCut;
- FBackNavButtonShortCut2, FForwardNavButtonShortCut2: TShortCut;
- FIgnoreTabSetClick: Boolean;
- FFirstTabSelectShortCut, FLastTabSelectShortCut: TShortCut;
- FCompileShortCut2: TShortCut;
- FUpdatePanelMessages: TUpdatePanelMessages;
- FHighContrastActive: Boolean;
- FDonateImageMenuItem: TMenuItem;
- procedure AppOnActivate(Sender: TObject);
- class procedure AppOnGetActiveFormHandle(var AHandle: HWND);
- procedure AppOnIdle(Sender: TObject; var Done: Boolean);
- function AskToDetachDebugger: Boolean;
- procedure BringToForeground;
- procedure BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
- procedure BuildAndSaveKnownIncludedAndHiddenFiles;
- procedure CloseTab(const TabIndex: Integer);
- procedure CompileFile(AFilename: String; const ReadFromFile: Boolean);
- procedure CompileIfNecessary;
- function ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
- procedure DebuggingStopped(const WaitForTermination: Boolean);
- procedure DebugLogMessage(const S: String);
- procedure DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
- function DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
- procedure DestroyDebugInfo;
- procedure DetachDebugger;
- function EvaluateConstant(const S: String; out Output: String): Integer;
- function EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
- out Output: String): Integer;
- function GetBorderStyle: TFormBorderStyle;
- procedure Go(const AStepMode: TStepMode);
- procedure HideError;
- function InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- function InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- function InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- function InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- procedure InvalidateStatusPanel(const Index: Integer);
- procedure LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
- procedure LoadKnownIncludedAndHiddenFilesAndUpdateMemos(const AFilename: String);
- procedure MemoCallTipArrowClick(Sender: TObject; const Up: Boolean);
- procedure MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
- procedure MemoCharAdded(Sender: TObject; Ch: AnsiChar);
- procedure MainMemoDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings);
- procedure MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
- procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure MemoKeyPress(Sender: TObject; var Key: Char);
- procedure MemoMarginClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- procedure MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- procedure MemoModifiedChange(Sender: TObject);
- procedure MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
- procedure MemoZoom(Sender: TObject);
- procedure NewMainFile(const IsReload: Boolean = False);
- procedure NewMainFileUsingWizard;
- procedure OpenFile(AMemo: TIDEScintFileEdit; AFilename: String; const MainMemoAddToRecentDocs: Boolean;
- const IsReload: Boolean = False);
- procedure OpenMRUMainFile(const AFilename: String);
- procedure ParseDebugInfo(DebugInfo: Pointer);
- procedure ReopenTabOrTabs(const HiddenFileIndex: Integer; const Activate: Boolean);
- procedure ResetAllMemosLineState;
- function SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
- procedure SetBorderStyle(Value: TFormBorderStyle);
- procedure SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
- procedure SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
- procedure ShowOpenMainFileDialog(const Examples: Boolean);
- procedure StatusBarCanvasDrawPanel(Canvas: TCanvas;
- Panel: TStatusPanel; const Rect: TRect);
- procedure StatusMessage(const Kind: TStatusMessageKind; const S: String);
- procedure SyncEditorOptions;
- function TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
- procedure ToggleBreakPoint(Line: Integer);
- procedure UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
- procedure UpdateAllMemosLineMarkers;
- procedure UpdateBevel1Visibility;
- procedure UpdateCaption;
- procedure UpdateCaretPosPanelAndBackNavStack;
- procedure UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal;
- const ASecondsRemaining: Integer; const ABytesCompressedPerSecond: Cardinal);
- procedure UpdateEditModeStatusPanel;
- procedure UpdateFindRegExUI;
- procedure UpdatePreprocMemos(const DontUpdateRelatedVisibilty: Boolean = False);
- procedure UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
- procedure UpdateImages;
- procedure UpdateMarginsAndAutoCompleteIcons;
- procedure UpdateMarginsAndSquigglyAndCaretWidths;
- procedure UpdateMemosTabSetVisibility;
- procedure UpdateModifiedStatusPanel;
- procedure UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
- procedure UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- procedure UpdateUpdatePanel;
- procedure UpdateKeyMapping;
- procedure UpdateTheme;
- procedure UpdateThemeData(const Open: Boolean);
- procedure UpdateStatusPanelHeight(H: Integer);
- procedure WMAppCommand(var Message: TMessage); message WM_APPCOMMAND;
- procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
- procedure WMDebuggerHello(var Message: TMessage); message WM_Debugger_Hello;
- procedure WMDebuggerGoodbye(var Message: TMessage); message WM_Debugger_Goodbye;
- procedure WMDebuggerQueryVersion(var Message: TMessage); message WM_Debugger_QueryVersion;
- procedure GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit;
- var DebugEntry: PDebugEntry);
- procedure DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
- procedure WMDebuggerStepped(var Message: TMessage); message WM_Debugger_Stepped;
- procedure WMDebuggerSteppedIntermediate(var Message: TMessage); message WM_Debugger_SteppedIntermediate;
- procedure WMDebuggerException(var Message: TMessage); message WM_Debugger_Exception;
- procedure WMDebuggerSetForegroundWindow(var Message: TMessage); message WM_Debugger_SetForegroundWindow;
- procedure WMDebuggerCallStackCount(var Message: TMessage); message WM_Debugger_CallStackCount;
- procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile;
- procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard;
- procedure WMStartNormally(var Message: TMessage); message WM_StartNormally;
- procedure WMDPIChanged(var Message: TMessage); message WM_DPICHANGED;
- procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
- procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
- procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
- procedure WMUAHDrawMenu(var Message: TMessage); message WM_UAHDRAWMENU;
- procedure WMUAHDrawMenuItem(var Message: TMessage); message WM_UAHDRAWMENUITEM;
- procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE;
- procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
- protected
- { Main objects }
- FMemos: TList<TIDEScintEdit>; { FMemos[0] is the main memo and FMemos[1] the preprocessor output memo - also see MemosTabSet comment above }
- FMainMemo: TIDEScintFileEdit; { Doesn't change }
- FPreprocessorOutputMemo: TIDEScintEdit; { Doesn't change and is the only memo which isnt a TIDEScint*File*Edit}
- FFileMemos: TList<TIDEScintFileEdit>; { All memos except FPreprocessorOutputMemo, including those without a tab }
- FHiddenFiles: TStringList; { List of files which *do* use a memo but are hidden by the user and have no tab }
- FActiveMemo: TIDEScintEdit; { Changes depending on user input }
- FErrorMemo, FStepMemo: TIDEScintFileEdit; { These change depending on user input }
- FMemosStyler: TInnoSetupStyler; { Single styler for all memos }
- { Used by class helpers }
- FCallTipState: TCallTipState;
- FCompiledExe: String;
- FCompiling: Boolean;
- FCurrentNavItem: TIDEScintEditNavItem;
- FDebugClientWnd: HWND;
- FDebugging: Boolean;
- FDebugTarget: TDebugTarget;
- FFindResults: TFindResults;
- FLastFindOptions: TFindOptions;
- FLastFindRegEx: Boolean;
- FLastFindText: String;
- FLastReplaceText: String;
- FMenuImageList: TVirtualImageList;
- FMenuBitmaps: TMenuBitmaps;
- FMenuBitmapsSize: TSize;
- FMenuBitmapsSourceImageCollection: TCustomImageCollection;
- FMRUMainFilesList: TStringList;
- FMRUMainFilesMenuItems: array[0..MRUListMaxCount-1] of TMenuItem;
- FMRUParametersList: TStringList;
- FMenuDarkBackgroundBrush: TBrush;
- FMenuDarkHotOrSelectedBrush: TBrush;
- FMenuThemeData: HTHEME;
- FNavStacks: TIDEScintEditNavStacks;
- FOptions: TOptions;
- FPaused: Boolean;
- FSignTools: TStringList;
- FTheme: TTheme;
- procedure CheckIfTerminated;
- function MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
- procedure MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
- const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean;
- const IsPosition: Boolean = False; const PositionVirtualSpace: Integer = 0);
- procedure ReopenTabClick(Sender: TObject);
- procedure SetStatusPanelVisible(const AVisible: Boolean);
- { Other }
- procedure WndProc(var Message: TMessage); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function IsShortCut(var Message: TWMKey): Boolean; override;
- published
- property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle;
- end;
- var
- MainForm: TMainForm;
- CommandLineFilename, CommandLineWizardName: String;
- CommandLineCompile: Boolean;
- CommandLineWizard: Boolean;
- implementation
- uses
- ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes, Themes, DateUtils,
- Math, StrUtils, WideStrUtils, TypInfo,
- PathFunc, TaskbarProgressFunc, NewUxTheme.TmSchema, BrowseFunc,
- Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, Shared.ScriptFunc,
- {$IFDEF STATICCOMPILER} Compiler.Compile, {$ENDIF}
- IDE.Messages, IDE.HtmlHelpFunc, IDE.ImagesModule,
- IDE.OptionsForm, IDE.StartupForm, IDE.Wizard.WizardForm, IDE.GotoFileForm,
- IDE.InputQueryComboForm, IDE.LicenseKeyForm, IDE.MainForm.FinalHelper,
- Shared.ConfigIniFile, Shared.SignToolsFunc, Shared.CompilerInt, Shared.LicenseFunc;
- {$R *.DFM}
- const
- { Memos }
- MaxMemos = 52; { Includes the main and preprocessor output memos }
- FirstIncludedFilesMemoIndex = 1; { This is an index into FFileMemos }
- LineStateGrowAmount = 4000;
- { TUpdatePanelMessage }
- constructor TUpdatePanelMessage.Create(const AMsg, AConfigIdent: String;
- const AConfigValue: Integer; const AColor: TColor; const AHasLink: Boolean);
- begin
- Msg := AMsg;
- ConfigIdent := AConfigIdent;
- ConfigValue := AConfigValue;
- Color := AColor;
- HasLink := AHasLink;
- end;
- { TMainFormPopupMenu }
- type
- TMainFormPopupMenu = class(TPopupMenu)
- private
- FParentMenuItem: TMenuItem;
- public
- constructor Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem); reintroduce; virtual;
- procedure Popup(X, Y: Integer); override;
- end;
- constructor TMainFormPopupMenu.Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem);
- begin
- inherited Create(AOwner);
- FParentMenuItem := ParentMenuItem;
- end;
- procedure TMainFormPopupMenu.Popup(X, Y: Integer);
- var
- Form: TMainForm;
- begin
- { Show the existing main menu's submenu }
- Form := Owner as TMainForm;
- var OldVisible := FParentMenuItem.Visible; { See ApplyMenuBitmaps }
- FParentMenuItem.Visible := True;
- try
- TrackPopupMenu(FParentMenuItem.Handle, TPM_RIGHTBUTTON, X, Y, 0, Form.Handle, nil);
- finally
- FParentMenuItem.Visible := OldVisible;
- end;
- end;
- { TMainForm }
- function TMainForm.InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- begin
- Memo.Align := alClient;
- Memo.Font.Name := GetPreferredMemoFont; { Default font only, see ReadConfig }
- Memo.Font.Size := 10;
- Memo.ShowHint := True;
- Memo.Styler := FMemosStyler;
- Memo.PopupMenu := PopupMenu;
- Memo.OnCallTipArrowClick := MemoCallTipArrowClick;
- Memo.OnChange := MemoChange;
- Memo.OnCharAdded := MemoCharAdded;
- Memo.OnHintShow := MemoHintShow;
- Memo.OnKeyDown := MemoKeyDown;
- Memo.OnKeyPress := MemoKeyPress;
- Memo.OnMarginClick := MemoMarginClick;
- Memo.OnMarginRightClick := MemoMarginRightClick;
- Memo.OnModifiedChange := MemoModifiedChange;
- Memo.OnUpdateUI := MemoUpdateUI;
- Memo.OnZoom := MemoZoom;
- Memo.Parent := BodyPanel;
- Memo.SetAutoCompleteSeparators(InnoSetupStylerWordListSeparator, InnoSetupStylerWordListTypeSeparator);
- Memo.SetWordChars(Memo.GetDefaultWordChars+'#{}[]');
- Memo.Theme := FTheme;
- Memo.StyleName := 'Windows';
- Memo.Visible := False;
- Result := Memo;
- end;
- function TMainForm.InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- begin
- InitializeMemoBase(Memo, PopupMenu);
- Memo.ChangeHistory := schMarkers;
- Memo.CompilerFileIndex := UnknownCompilerFileIndex;
- Memo.ErrorLine := -1;
- Memo.StepLine := -1;
- Result := Memo;
- end;
- function TMainForm.InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
- begin
- InitializeFileMemo(Memo, PopupMenu);
- Memo.AcceptDroppedFiles := True;
- Memo.CompilerFileIndex := -1;
- Memo.OnDropFiles := MainMemoDropFiles;
- Memo.Used := True;
- Result := Memo;
- end;
- function TMainForm.InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
- begin
- InitializeMemoBase(Memo, PopupMenu);
- Memo.ReadOnly := True;
- Result := Memo;
- end;
- constructor TMainForm.Create(AOwner: TComponent);
- procedure CheckUpdatePanelMessage(const Ini: TConfigIniFile; const ConfigIdent: String;
- const ConfigValueDefault, ConfigValueMinimum, ConfigValueNew: Integer; const Msg: String; const Color: TColor;
- const HasLink: Boolean); overload;
- begin
- var ConfigValue := Ini.ReadInteger('UpdatePanel', ConfigIdent, ConfigValueDefault); { Also see HUnregisterClick }
- if ConfigValue < ConfigValueMinimum then
- FUpdatePanelMessages.Add(TUpdatePanelMessage.Create(Msg, ConfigIdent, ConfigValueNew, Color,
- HasLink));
- end;
- procedure CheckUpdatePanelMessage(const Ini: TConfigIniFile; const ConfigIdent: String;
- const ConfigValueDefault, ConfigValueExpected: Integer; const Msg: String; const Color: TColor;
- const HasLink: Boolean); overload;
- begin
- CheckUpdatePanelMessage(Ini, ConfigIdent, ConfigValueDefault, ConfigValueExpected, ConfigValueExpected,
- Msg, Color, HasLink);
- end;
- procedure ReadAndApplyConfig;
- var
- Ini: TConfigIniFile;
- WindowPlacement: TWindowPlacement;
- I: Integer;
- Memo: TIDEScintEdit;
- begin
- Ini := TConfigIniFile.Create;
- try
- { Menu check boxes state }
- ToolbarPanel.Visible := Ini.ReadBool('Options', 'ShowToolbar', True);
- StatusBar.Visible := Ini.ReadBool('Options', 'ShowStatusBar', True);
- FOptions.LowPriorityDuringCompile := Ini.ReadBool('Options', 'LowPriorityDuringCompile', False);
- { Configuration options - does not read ThemeType, see ReadAndUpdateTheme instead }
- FOptions.ShowStartupForm := Ini.ReadBool('Options', 'ShowStartupForm', True);
- FOptions.UseWizard := Ini.ReadBool('Options', 'UseWizard', True);
- FOptions.Autosave := Ini.ReadBool('Options', 'Autosave', False);
- FOptions.Autoreload := Ini.ReadBool('Options', 'Autoreload', True);
- FOptions.MakeBackups := Ini.ReadBool('Options', 'MakeBackups', False);
- FOptions.FullPathInTitleBar := Ini.ReadBool('Options', 'FullPathInTitleBar', False);
- FOptions.UndoAfterSave := Ini.ReadBool('Options', 'UndoAfterSave', True);
- FOptions.UndoAfterReload := Ini.ReadBool('Options', 'UndoAfterReload', True);
- FOptions.PauseOnDebuggerExceptions := Ini.ReadBool('Options', 'PauseOnDebuggerExceptions', True);
- FOptions.RunAsDifferentUser := Ini.ReadBool('Options', 'RunAsDifferentUser', False);
- FOptions.AutoAutoComplete := Ini.ReadBool('Options', 'AutoComplete', True);
- FOptions.AutoCallTips := Ini.ReadBool('Options', 'AutoCallTips', True);
- FOptions.UseSyntaxHighlighting := Ini.ReadBool('Options', 'UseSynHigh', True);
- FOptions.ColorizeCompilerOutput := Ini.ReadBool('Options', 'ColorizeCompilerOutput', True);
- FOptions.UnderlineErrors := Ini.ReadBool('Options', 'UnderlineErrors', True);
- FOptions.HighlightWordAtCursorOccurrences := Ini.ReadBool('Options', 'HighlightWordAtCursorOccurrences', False);
- FOptions.HighlightSelTextOccurrences := Ini.ReadBool('Options', 'HighlightSelTextOccurrences', True);
- FOptions.CursorPastEOL := Ini.ReadBool('Options', 'EditorCursorPastEOL', False);
- FOptions.TabWidth := Ini.ReadInteger('Options', 'TabWidth', 2);
- FOptions.UseTabCharacter := Ini.ReadBool('Options', 'UseTabCharacter', False);
- FOptions.ShowWhiteSpace := Ini.ReadBool('Options', 'ShowWhiteSpace', False);
- FOptions.UseFolding := Ini.ReadBool('Options', 'UseFolding', True);
- FOptions.FindRegEx := Ini.ReadBool('Options', 'FindRegEx', False);
- FOptions.WordWrap := Ini.ReadBool('Options', 'WordWrap', False);
- FOptions.AutoIndent := Ini.ReadBool('Options', 'AutoIndent', True);
- FOptions.IndentationGuides := Ini.ReadBool('Options', 'IndentationGuides', True);
- FOptions.GutterLineNumbers := Ini.ReadBool('Options', 'GutterLineNumbers', False);
- FOptions.ShowPreprocessorOutput := Ini.ReadBool('Options', 'ShowPreprocessorOutput', True);
- FOptions.OpenIncludedFiles := Ini.ReadBool('Options', 'OpenIncludedFiles', True);
- FOptions.AutoHideNewIncludedFiles := Ini.ReadBool('Options', 'AutoHideNewIncludedFiles', False);
- I := Ini.ReadInteger('Options', 'KeyMappingType', Ord(GetDefaultKeyMappingType));
- if (I >= 0) and (I <= Ord(High(TKeyMappingType))) then
- FOptions.KeyMappingType := TKeyMappingType(I);
- I := Ini.ReadInteger('Options', 'MemoKeyMappingType', Ord(GetDefaultMemoKeyMappingType));
- if (I >= 0) and (I <= Ord(High(TIDEScintKeyMappingType))) then
- FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(I);
- FMainMemo.Font.Name := Ini.ReadString('Options', 'EditorFontName', FMainMemo.Font.Name);
- FMainMemo.Font.Size := Ini.ReadInteger('Options', 'EditorFontSize', 10);
- FMainMemo.Font.Charset := Ini.ReadInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
- FMainMemo.Zoom := Ini.ReadInteger('Options', 'Zoom', 0); { MemoZoom will zoom the other memos }
- for Memo in FMemos do
- if Memo <> FMainMemo then
- Memo.Font := FMainMemo.Font;
- { UpdatePanel visibility }
- const BannerGreen = $ABE3AB; { MGreen with HSL lightness changed from 40% to 78% }
- const BannerBlue = $FFD399; { MBlue with HSL lightness changed from 42% to 80% }
- const BannerOrange = $9EB8F0; {MOrange with HSL lightness changed from 63% to 78% }
- const BannerRed = $BBB5EE; {MRed with HSL lightness changed from 58% to 82% }
- CheckUpdatePanelMessage(Ini, 'KnownVersion', 0, Integer(FCompilerVersion.BinVersion),
- 'Your version of Inno Setup has been updated! <a id="hwhatsnew">See what''s new</a>.',
- BannerGreen, True);
- CheckUpdatePanelMessage(Ini, 'VSCodeMemoKeyMap', 0, 1,
- 'VS Code-style editor shortcuts added! Use the <a id="toptions-vscode">Editor Keys option</a> in Options dialog.',
- BannerBlue, True);
- const LicenseState = GetLicenseState;
- if LicenseState = lsExpiredButUpdated then begin
- { Complain twice per day }
- const CurrentHourAsInt = FormatDateTime('yyyymmddhh', Now).ToInteger;
- const WarnAgainHourAsInt = FormatDateTime('yyyymmddhh', IncHour(Now, 12)).ToInteger;
- 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>.';
- CheckUpdatePanelMessage(Ini, 'Purchase.ExpiredButUpdated', 0, CurrentHourAsInt, WarnAgainHourAsInt, { Also see UpdateUpdatePanel }
- Msg, BannerRed, True);
- end else if LicenseState in [lsExpiring, lsExpired] then begin
- { Warn about expiry, once per week }
- const CurrentDateAsInt = FormatDateTime('yyyymmdd', Date).ToInteger;
- const WarnAgainDateAsInt = FormatDateTime('yyyymmdd', IncDay(Date, 7)).ToInteger;
- const Msg = IfThen(LicenseState = lsExpiring,
- 'Your update entitlement is ending soon. Please <a id="hpurchase">renew your license</a>. Thanks!',
- 'Your update entitlement has ended. Please <a id="hpurchase">renew your license</a>. Thanks!');
- CheckUpdatePanelMessage(Ini, 'Purchase.Renew', 0, CurrentDateAsInt, WarnAgainDateAsInt, { Also see UpdateUpdatePanel }
- Msg, BannerOrange, True);
- end else if LicenseState = lsNotLicensed then begin
- { Ask about current commercial use, once per month }
- const CurrentDateAsInt = FormatDateTime('yyyymmdd', Date).ToInteger;
- const AskAgainDateAsInt = FormatDateTime('yyyymmdd', IncDay(IncMonth(Date, 6), -1)).ToInteger; { Also see HUnregisterClick }
- CheckUpdatePanelMessage(Ini, 'Purchase', 0, CurrentDateAsInt, AskAgainDateAsInt, { Also see UpdateUpdatePanel and HUnregisterClick }
- 'Using Inno Setup commercially? Please <a id="hpurchase">purchase a license</a>. Thanks!',
- BannerBlue, True);
- end;
- UpdateUpdatePanel;
- { Debug options }
- FOptions.ShowCaretPosition := Ini.ReadBool('Options', 'ShowCaretPosition', False);
- if FOptions.ShowCaretPosition then begin
- StatusBar.Panels[spCaretPos].Width := MulDiv(StatusBar.Panels[spCaretPos].Width, 7, 2);
- StatusBar.Panels[spCaretPos].Alignment := taLeftJustify;
- end;
- SyncEditorOptions;
- UpdateNewMainFileButtons;
- UpdateKeyMapping;
- UpdateFindRegExUI;
- { Window state }
- WindowPlacement.length := SizeOf(WindowPlacement);
- GetWindowPlacement(Handle, @WindowPlacement);
- WindowPlacement.showCmd := SW_HIDE; { the form isn't Visible yet }
- WindowPlacement.rcNormalPosition.Left := Ini.ReadInteger('State',
- 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
- WindowPlacement.rcNormalPosition.Top := Ini.ReadInteger('State',
- 'WindowTop', WindowPlacement.rcNormalPosition.Top);
- WindowPlacement.rcNormalPosition.Right := Ini.ReadInteger('State',
- 'WindowRight', WindowPlacement.rcNormalPosition.Left + Width);
- WindowPlacement.rcNormalPosition.Bottom := Ini.ReadInteger('State',
- 'WindowBottom', WindowPlacement.rcNormalPosition.Top + Height);
- SetWindowPlacement(Handle, @WindowPlacement);
- { Note: Must set WindowState *after* calling SetWindowPlacement, since
- TCustomForm.WMSize resets WindowState }
- if Ini.ReadBool('State', 'WindowMaximized', False) then
- WindowState := wsMaximized;
- { Note: Don't call UpdateStatusPanelHeight here since it clips to the
- current form height, which hasn't been finalized yet }
- { StatusPanel height }
- StatusPanel.Height := ToCurrentPPI(Ini.ReadInteger('State', 'StatusPanelHeight',
- (10 * FromCurrentPPI(DebugOutputList.ItemHeight) + 4) + FromCurrentPPI(OutputTabSet.Height)));
- finally
- Ini.Free;
- end;
- FOptionsLoaded := True;
- end;
- procedure ReadAndApplyTheme;
- begin
- const Ini = TConfigIniFile.Create;
- try
- const I = Ini.ReadInteger('Options', 'ThemeType', Ord(GetDefaultThemeType));
- if (I >= 0) and (I <= Ord(High(TThemeType))) then
- FOptions.ThemeType := TThemeType(I);
- finally
- Ini.Free
- end;
- UpdateTheme;
- end;
- var
- I: Integer;
- NewItem: TMenuItem;
- PopupMenu: TPopupMenu;
- Memo: TIDEScintEdit;
- begin
- inherited;
- {$IFNDEF STATICCOMPILER}
- FCompilerVersion := ISDllGetVersion;
- {$ELSE}
- FCompilerVersion := ISGetVersion;
- {$ENDIF}
- FModifiedAnySinceLastCompile := True;
- InitFormFont(Self);
- FHighContrastActive := HighContrastActive; { Just checking once at startup }
- if FHighContrastActive then begin
- { If UseVisualStyle is False (LWS_USEVISUALSTYLE is off) the regular text of the label does not
- follow any high contrast theme but stays black instead, which is likely to be invisible.
- Setting it to True makes all text (regular and link) to get the COLOR_HOTLIGHT color. }
- UpdateLinkLabel.UseVisualStyle := True;
- { COLOR_WINDOW is documented as the associated background color of COLOR_HOTLIGHT }
- UpdatePanel.Color := GetSysColor(COLOR_WINDOW);
- end;
- { For some reason, if AutoScroll=False is set on the form Delphi ignores the
- 'poDefault' Position setting }
- AutoScroll := False;
- { Append the shortcut key text to the Edit items. Don't actually set the
- ShortCut property because we don't want the key combinations having an
- effect when Memo doesn't have the focus. }
- SetFakeShortCut(EUndo, Ord('Z'), [ssCtrl]);
- SetFakeShortCut(ERedo, Ord('Y'), [ssCtrl]);
- SetFakeShortCut(ECut, Ord('X'), [ssCtrl]);
- SetFakeShortCut(ECopy, Ord('C'), [ssCtrl]);
- SetFakeShortCut(EPaste, Ord('V'), [ssCtrl]);
- SetFakeShortCut(ESelectAll, Ord('A'), [ssCtrl]);
- SetFakeShortCut(EDelete, VK_DELETE, []);
- 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 }
- SetFakeShortCutText(VZoomOut, SmkcCtrl + 'Num -');
- SetFakeShortCutText(VZoomReset, SmkcCtrl + 'Num /');
- { Use fake Esc shortcut for Stop Compile so it doesn't conflict with the
- editor's autocompletion list }
- SetFakeShortCut(BStopCompile, VK_ESCAPE, []);
- { Use fake Ctrl+F4 shortcut for VCloseCurrentTab2 because VCloseCurrentTab
- already has the real one }
- SetFakeShortCut(VCloseCurrentTab2, VK_F4, [ssCtrl]);
- { Use fake Ctrl+C and Ctrl+A shortcuts for OutputListPopupMenu's items so they
- don't conflict with the editor which also uses fake shortcuts for these }
- SetFakeShortCut(POutputListCopy, Ord('C'), [ssCtrl]);
- SetFakeShortCut(POutputListSelectAll, Ord('A'), [ssCtrl]);
- { Set real shortcut on TOptions which can't be set at design time }
- TOptions.ShortCut := ShortCut(VK_OEM_COMMA, [ssCtrl]);
- PopupMenu := TMainFormPopupMenu.Create(Self, EMenu);
- FMemosStyler := TInnoSetupStyler.Create(Self);
- FMemosStyler.ISPPInstalled := ISPPInstalled;
- FTheme := TTheme.Create;
- InitFormThemeInit(FTheme);
- MemosTabSet.Theme := FTheme;
- OutputTabSet.Theme := FTheme;
- ToolBarPanel.ParentBackground := False;
- UpdatePanel.ParentBackground := False;
- UpdatePanelDonateBitBtn.Hint := RemoveAccelChar(HDonate.Caption);
- UpdateImages;
- FMemos := TList<TIDEScintEdit>.Create;
- FMainMemo := InitializeMainMemo(TIDEScintFileEdit.Create(Self), PopupMenu);
- FMemos.Add(FMainMemo);
- FPreprocessorOutputMemo := InitializeNonFileMemo(TIDEScintEdit.Create(Self), PopupMenu);
- FMemos.Add(FPreprocessorOutputMemo);
- for I := FMemos.Count to MaxMemos-1 do
- FMemos.Add(InitializeFileMemo(TIDEScintFileEdit.Create(Self), PopupMenu));
- FFileMemos := TList<TIDEScintFileEdit>.Create;
- for Memo in FMemos do
- if Memo is TIDEScintFileEdit then
- FFileMemos.Add(TIDEScintFileEdit(Memo));
- FHiddenFiles := TStringList.Create(dupError, True, False);
- FHiddenFiles.UseLocale := False;
- FActiveMemo := FMainMemo;
- FActiveMemo.Visible := True;
- ActiveControl := FActiveMemo;
- FErrorMemo := FMainMemo;
- FStepMemo := FMainMemo;
- UpdateMarginsAndSquigglyAndCaretWidths;
- FMemosStyler.Theme := FTheme;
- MemosTabSet.PopupMenu := TMainFormPopupMenu.Create(Self, MemosTabSetPopupMenu);
- FFirstTabSelectShortCut := ShortCut(Ord('1'), [ssCtrl]);
- FLastTabSelectShortCut := ShortCut(Ord('9'), [ssCtrl]);
- FNavStacks := TIDEScintEditNavStacks.Create;
- UpdateNavigationButtons;
- FCurrentNavItem.Invalidate;
- BackNavButton.Style := tbsDropDown;
- BackNavButton.DropdownMenu := TMainFormPopupMenu.Create(Self, NavPopupMenu);
- PopupMenu := TMainFormPopupMenu.Create(Self, OutputListPopupMenu);
- CompilerOutputList.PopupMenu := PopupMenu;
- DebugOutputList.PopupMenu := PopupMenu;
- DebugCallStackList.PopupMenu := PopupMenu;
- FindResultsList.PopupMenu := PopupMenu;
- UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- Application.HintShortPause := 0;
- Application.OnException := AppOnException;
- Application.OnActivate := AppOnActivate;
- Application.OnIdle := AppOnIdle;
- FMRUMainFilesList := TStringList.Create;
- for I := 0 to High(FMRUMainFilesMenuItems) do begin
- NewItem := TMenuItem.Create(Self);
- NewItem.OnClick := FMRUClick;
- FRecent.Insert(I, NewItem);
- FMRUMainFilesMenuItems[I] := NewItem;
- end;
- FMRUParametersList := TStringList.Create;
- FSignTools := TStringList.Create;
- FFindResults := TFindResults.Create;
- FIncludedFiles := TIncludedFiles.Create;
- UpdatePreprocMemos;
- FDebugTarget := dtSetup;
- UpdateTargetMenu;
- ReadLicense;
- UpdateCaption;
- FMenuDarkBackgroundBrush := TBrush.Create;
- FMenuDarkHotOrSelectedBrush := TBrush.Create;
- LightToolbarVirtualImageList.AutoFill := True;
- ThemedMarkersAndACVirtualImageList.AutoFill := True;
- UpdateThemeData(True);
- FMenuBitmaps := TMenuBitmaps.Create;
- FMenuBitmapsSize.cx := 0;
- FMenuBitmapsSize.cy := 0;
- FKeyMappedMenus := TKeyMappedMenus.Create;
- FCallTipState.MaxCallTips := 1; { Just like SciTE 5.50 }
- FUpdatePanelMessages := TUpdatePanelMessages.Create;
- if CommandLineCompile then begin
- ReadAndApplyTheme;
- ReadSignTools(FSignTools);
- PostMessage(Handle, WM_StartCommandLineCompile, 0, 0)
- end else if CommandLineWizard then begin
- { Stop Delphi from showing the compiler form }
- Application.ShowMainForm := False;
- { Show wizard form later }
- ReadAndApplyTheme;
- PostMessage(Handle, WM_StartCommandLineWizard, 0, 0);
- end else begin
- ReadAndApplyConfig;
- ReadAndApplyTheme;
- ReadSignTools(FSignTools);
- PostMessage(Handle, WM_StartNormally, 0, 0);
- end;
- end;
- destructor TMainForm.Destroy;
- procedure SaveConfig;
- var
- Ini: TConfigIniFile;
- WindowPlacement: TWindowPlacement;
- begin
- Ini := TConfigIniFile.Create;
- try
- { Theme state - can change without opening the options }
- Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see TOptionsClick }
- { Menu check boxes state }
- Ini.WriteBool('Options', 'ShowToolbar', ToolbarPanel.Visible);
- Ini.WriteBool('Options', 'ShowStatusBar', StatusBar.Visible);
- Ini.WriteBool('Options', 'LowPriorityDuringCompile', FOptions.LowPriorityDuringCompile);
- { Window state }
- WindowPlacement.length := SizeOf(WindowPlacement);
- GetWindowPlacement(Handle, @WindowPlacement);
- Ini.WriteInteger('State', 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
- Ini.WriteInteger('State', 'WindowTop', WindowPlacement.rcNormalPosition.Top);
- Ini.WriteInteger('State', 'WindowRight', WindowPlacement.rcNormalPosition.Right);
- Ini.WriteInteger('State', 'WindowBottom', WindowPlacement.rcNormalPosition.Bottom);
- { The GetWindowPlacement docs claim that "flags" is always zero.
- Fortunately, that's wrong. WPF_RESTORETOMAXIMIZED is set when the
- window is either currently maximized, or currently minimized from a
- previous maximized state. }
- Ini.WriteBool('State', 'WindowMaximized', WindowPlacement.flags and WPF_RESTORETOMAXIMIZED <> 0);
- Ini.WriteInteger('State', 'StatusPanelHeight', FromCurrentPPI(StatusPanel.Height));
- { Zoom state }
- Ini.WriteInteger('Options', 'Zoom', FMainMemo.Zoom); { Only saves the main memo's zoom }
- finally
- Ini.Free;
- end;
- end;
- begin
- UpdateThemeData(False);
- Application.OnActivate := nil;
- Application.OnIdle := nil;
- if FOptionsLoaded and not (CommandLineCompile or CommandLineWizard) then
- SaveConfig;
- if FDevMode <> 0 then
- GlobalFree(FDevMode);
- if FDevNames <> 0 then
- GlobalFree(FDevNames);
- FUpdatePanelMessages.Free;
- FNavStacks.Free;
- FKeyMappedMenus.Free;
- FMenuBitmaps.Free;
- FMenuDarkBackgroundBrush.Free;
- FMenuDarkHotOrSelectedBrush.Free;
- FTheme.Free;
- DestroyDebugInfo;
- FIncludedFiles.Free;
- FFindResults.Free;
- FSignTools.Free;
- FMRUParametersList.Free;
- FMRUMainFilesList.Free;
- FFileMemos.Free;
- FHiddenFiles.Free;
- FMemos.Free;
- inherited;
- end;
- function TMainForm.GetBorderStyle: TFormBorderStyle;
- begin
- Result := inherited BorderStyle;
- end;
- procedure TMainForm.SetBorderStyle(Value: TFormBorderStyle);
- begin
- { Hack: To stop the Delphi IDE from adding Explicit* properties to the .dfm
- file every time the unit is saved, we set BorderStyle=bsNone on the form.
- At run-time, ignore that setting so that BorderStyle stays at the default
- value, bsSizeable.
- It would be simpler to change BorderStyle from bsNone to bsSizeable in the
- form's constructor, but it doesn't quite work: when a form's handle is
- created while BorderStyle=bsNone, Position=poDefault behaves like
- poDefaultPosOnly (see TCustomForm.CreateParams). }
- if Value <> bsNone then
- inherited BorderStyle := Value;
- end;
- class procedure TMainForm.AppOnGetActiveFormHandle(var AHandle: HWND);
- begin
- { As of Delphi 11.3, the default code in TApplication.GetActiveFormHandle
- (which runs after this handler) calls GetActiveWindow, and if that returns
- 0, it calls GetLastActivePopup(Application.Handle).
- The problem is that when the application isn't in the foreground,
- GetActiveWindow returns 0, and when MainFormOnTaskBar=True, the
- GetLastActivePopup call normally just returns Application.Handle (since
- there are no popups owned by the application window).
- So if the application calls Application.MessageBox while it isn't in the
- foreground, that message box will be owned by Application.Handle, not by
- the last-active window as it should be. That can lead to the message box
- falling behind the main form in z-order.
- To rectify that, when no window is active and MainFormOnTaskBar=True, we
- fall back to returning the handle of the main form's last active popup,
- which is the window that would be activated if the main form's taskbar
- button were clicked. (If Application.Handle is active, we treat that the
- same as no active window because Application.Handle shouldn't be the owner
- of any windows when MainFormOnTaskBar=True.)
- If there is no assigned main form or if MainFormOnTaskBar=False, then we
- fall back to the default handling. }
- if Application.MainFormOnTaskBar then begin
- AHandle := GetActiveWindow;
- if ((AHandle = 0) or (AHandle = Application.Handle)) and
- Assigned(Application.MainForm) and
- Application.MainForm.HandleAllocated then
- AHandle := GetLastActivePopup(Application.MainFormHandle);
- end;
- end;
- procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
- NewDPI: Integer);
- begin
- UpdateImages;
- UpdateMarginsAndAutoCompleteIcons;
- UpdateMarginsAndSquigglyAndCaretWidths;
- UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- UpdateStatusPanelHeight(StatusPanel.Height);
- end;
- procedure TMainForm.FormCloseQuery(Sender: TObject;
- var CanClose: Boolean);
- begin
- if IsWindowEnabled(Handle) then
- CanClose := ConfirmCloseFile(True)
- else
- { CloseQuery is also called by the VCL when a WM_QUERYENDSESSION message
- is received. Don't display message box if a modal dialog is already
- displayed. }
- CanClose := False;
- end;
- procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure AddControlToArray(const ControlToAdd: TWinControl; var Controls: TArray<TWinControl>;
- var NControls: Integer);
- begin
- Inc(NControls);
- SetLength(Controls, NControls);
- Controls[NControls-1] := ControlToAdd;
- end;
- begin
- var AShortCut := ShortCut(Key, Shift);
- if (AShortCut = VK_ESCAPE) and BStopCompile.Enabled then begin
- Key := 0; { Intentionally only done when BStopCompile is enabled to allow the memo to process it instead }
- BStopCompileClick(Self)
- end else if (AShortCut = FBackNavButtonShortCut) or
- ((FBackNavButtonShortCut2 <> 0) and (AShortCut = FBackNavButtonShortCut2)) then begin
- Key := 0;
- if BackNavButton.Enabled then
- BackNavButtonClick(Self);
- end else if (AShortCut = FForwardNavButtonShortCut) or
- ((FForwardNavButtonShortCut2 <> 0) and (AShortCut = FForwardNavButtonShortCut2)) then begin
- Key := 0;
- if ForwardNavButton.Enabled then
- ForwardNavButtonClick(Self);
- end else if (AShortCut >= FFirstTabSelectShortCut) and (AShortCut <= FLastTabSelectShortCut) then begin
- Key := 0;
- if MemosTabSet.Visible then begin
- var TabIndex := AShortCut - FFirstTabSelectShortCut;
- if TabIndex < 8 then begin
- if TabIndex < MemosTabSet.Tabs.Count then
- MemosTabSet.TabIndex := TabIndex;
- end else { Ctrl+9 = Select last tab }
- MemosTabSet.TabIndex := MemosTabSet.Tabs.Count-1;
- end;
- end else if AShortCut = FCompileShortCut2 then begin
- Key := 0;
- if BCompile.Enabled then
- BCompileClick(Self);
- end else if (Key = Ord('W')) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssCtrl]) then begin
- Key := 0;
- UpdateViewMenu(VMenu); { VCloseCurrentTab.Enabled is not kept updated }
- if VCloseCurrentTab.Enabled then
- VCloseCurrentTabClick(Self);
- end else if (Key = VK_F6) and not (ssAlt in Shift) then begin
- { Move focus between the active memo, the active bottom pane, and the active banner }
- Key := 0;
- { First get the list of controls to toggle between }
- var Controls: TArray<TWinControl> := [FActiveMemo];
- var NControls := Length(Controls);
- if StatusPanel.Visible then begin
- var ControlToAdd: TWinControl := nil;
- case OutputTabSet.TabIndex of
- tiCompilerOutput: ControlToAdd := CompilerOutputList;
- tiDebugOutput: ControlToAdd := DebugOutputList;
- tiDebugCallStack: ControlToAdd := DebugCallStackList;
- tiFindResults: ControlToAdd := FindResultsList;
- end;
- if ControlToAdd <> nil then
- AddControlToArray(ControlToAdd, Controls, NControls);
- end;
- if UpdatePanel.Visible then begin
- if FUpdatePanelMessages[UpdateLinkLabel.Tag].HasLink then
- AddControlToArray(UpdateLinkLabel, Controls, NControls);
- AddControlToArray(UpdatePanelDonateBitBtn, Controls, NControls);
- AddControlToArray(UpdatePanelCloseBitBtn, Controls, NControls);
- end;
- { Now move focus to next }
- if NControls > 1 then begin
- for var I := 0 to NControls-1 do begin
- if ActiveControl = Controls[I] then begin
- if I = NControls-1 then
- ActiveControl := Controls[0]
- else
- ActiveControl := Controls[I+1];
- Exit;
- end;
- end;
- end;
- { Didn't move }
- if ActiveControl <> FActiveMemo then
- ActiveControl := FActiveMemo;
- end;
- end;
- procedure TMainForm.MemoKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then begin
- var Memo := Sender as TIDEScintEdit;
- { Make sure we don't break the special rectangular select shortcuts }
- if Shift * [ssShift, ssAlt, ssCtrl] <> Memo.GetRectExtendShiftState(True) then begin
- if Memo.SelectionMode in [ssmRectangular, ssmThinRectangular] then begin
- { Allow left/right/etc. navigation with rectangular selection, see
- https://sourceforge.net/p/scintilla/feature-requests/1275/ and
- https://sourceforge.net/p/scintilla/bugs/2412/#cb37
- Notepad++ calls this "Enable Column Selection to Multi-editing" which
- is on by default and in VSCode and VS it's also on by default. }
- Memo.SelectionMode := ssmStream;
- end;
- end;
- { Key is not cleared to allow Scintilla to do the actual handling }
- end;
- if Key = VK_F1 then begin
- Key := 0;
- var HelpFile := GetHelpFile;
- if Assigned(HtmlHelp) then begin
- HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_DISPLAY_TOPIC, 0);
- var S := FActiveMemo.WordAtCaret;
- if S <> '' then begin
- var KLink: THH_AKLINK;
- FillChar(KLink, SizeOf(KLink), 0);
- KLink.cbStruct := SizeOf(KLink);
- KLink.pszKeywords := PChar(S);
- KLink.fIndexOnFail := True;
- HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_KEYWORD_LOOKUP, DWORD(@KLink));
- end;
- end;
- end else if ((Key = Ord('V')) or (Key = VK_INSERT)) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssCtrl]) then begin
- if FActiveMemo.CanPaste then
- if MultipleSelectionPasteFromClipboard(FActiveMemo) then
- Key := 0;
- end else if (Key = VK_SPACE) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssShift, ssCtrl]) then begin
- Key := 0;
- CallTipsHandleCtrlSpace(FActiveMemo);
- end else begin
- var AShortCut := ShortCut(Key, Shift);
- { Check if the memo keymap wants us to handle the shortcut but first check
- the menu keymap didn't already claim the same shortcut. Other shortcuts
- (which are always same and not set by the menu keymap) are assumed to
- never conflict. }
- if not FKeyMappedMenus.ContainsKey(AShortCut) then begin
- var ComplexCommand := FActiveMemo.GetComplexCommand(AShortCut);
- if ComplexCommand <> ccNone then begin
- if Key <> VK_ESCAPE then { Allow Scintilla to see Esc }
- Key := 0;
- case ComplexCommand of
- ccSelectNextOccurrence:
- ESelectNextOccurrenceClick(Self);
- ccSelectAllOccurrences:
- ESelectAllOccurrencesClick(Self);
- ccSelectAllFindMatches:
- ESelectAllFindMatchesClick(Self);
- ccFoldLine:
- EFoldOrUnfoldLineClick(EFoldLine);
- ccUnfoldLine:
- EFoldOrUnfoldLineClick(EUnfoldLine);
- ccSimplifySelection:
- SimplifySelection(FActiveMemo);
- ccToggleLinesComment:
- EToggleLinesCommentClick(Self); //GetComplexCommand already checked ReadOnly for us
- ccAddCursorUp, ccAddCursorDown:
- AddCursorUpOrDown(FActiveMemo, ComplexCommand = ccAddCursorUp);
- ccBraceMatch:
- EBraceMatchClick(Self);
- ccAddCursorsToLineEnds:
- AddCursorsToLineEnds(FActiveMemo);
- else
- raise Exception.Create('Unknown ComplexCommand');
- end;
- end;
- end;
- end;
- end;
- procedure TMainForm.MemoKeyPress(Sender: TObject; var Key: Char);
- begin
- if ((Key = #9) or (Key = ' ')) and (GetKeyState(VK_CONTROL) < 0) then begin
- { About #9, as Wikipedia explains: "The most known and common tab is a
- horizontal tabulation <..> and may be referred to as Ctrl+I." Ctrl+I is
- (just like in Visual Studio Code) our alternative code completion character
- because Ctrl+Space is used by the Chinese IME and Alt+Right is used for the
- forward button. So that's why we handle #9 here. Doesn't mean Ctrl+Tab
- doesn't work: it doesnt trigger KeyPress, even if it wasn't a menu
- shortcut for Next Tab (which it is). }
- InitiateAutoComplete(FActiveMemo, #0);
- Key := #0;
- end else if (Key <= #31) or (Key = #127) then begin
- { Prevent "control characters" from being entered in text. Don't need to be
- concerned about #9 or #10 or #13 etc here. Based on Notepad++'s WM_CHAR
- handling in ScintillaEditView.cpp.
- Also don't need to be concerned about shortcuts like Ctrl+Shift+- which
- equals #31. }
- Key := #0
- end;
- end;
- procedure TMainForm.FormResize(Sender: TObject);
- begin
- { Make sure the status panel's height is decreased if necessary in response
- to the form's height decreasing }
- if StatusPanel.Visible then
- UpdateStatusPanelHeight(StatusPanel.Height);
- end;
- procedure TMainForm.WndProc(var Message: TMessage);
- begin
- { Without this, the status bar's owner drawn panels sometimes get corrupted and show
- menu items instead. See:
- http://groups.google.com/group/borland.public.delphi.vcl.components.using/browse_thread/thread/e4cb6c3444c70714 }
- with Message do
- case Msg of
- WM_DRAWITEM:
- with PDrawItemStruct(Message.LParam)^ do
- if (CtlType = ODT_MENU) and not IsMenu(hwndItem) then
- CtlType := ODT_STATIC;
- end;
- inherited
- end;
- function TMainForm.IsShortCut(var Message: TWMKey): Boolean;
- begin
- { Key messages are forwarded by the VCL to the main form for ShortCut
- processing. In Delphi 5+, however, this happens even when a TFindDialog
- is active, causing Ctrl+V/Esc/etc. to be intercepted by the main form.
- Work around this by always returning False when not Active. }
- if Active then
- Result := inherited IsShortCut(Message)
- else
- Result := False;
- end;
- procedure TMainForm.UpdateCaption;
- var
- NewCaption: String;
- begin
- if FMainMemo.Filename = '' then
- NewCaption := GetFileTitle(FMainMemo.Filename)
- else begin
- if FOptions.FullPathInTitleBar then
- NewCaption := FMainMemo.Filename
- else
- NewCaption := GetDisplayFilename(FMainMemo.Filename);
- end;
- NewCaption := NewCaption + ' '#$2013' ' + SCompilerFormCaption + ' ' +
- String(FCompilerVersion.Version) + ' '#$2013' ' + GetLicenseeDescription;
- if FCompiling then
- NewCaption := NewCaption + ' [Compiling]'
- else if FDebugging then begin
- if not FPaused then
- NewCaption := NewCaption + ' [Running]'
- else
- NewCaption := NewCaption + ' [Paused]';
- end;
- Caption := NewCaption;
- if not CommandLineWizard then
- Application.Title := NewCaption;
- end;
- procedure TMainForm.NewMainFile(const IsReload: Boolean);
- var
- Memo: TIDEScintFileEdit;
- begin
- HideError;
- FUninstExe := '';
- if FDebugTarget <> dtSetup then begin
- FDebugTarget := dtSetup;
- UpdateTargetMenu;
- end;
- FHiddenFiles.Clear;
- InvalidateStatusPanel(spHiddenFilesCount);
- for Memo in FFileMemos do
- if Memo.Used then
- Memo.BreakPoints.Clear;
- DestroyDebugInfo;
- FMainMemo.Filename := '';
- UpdateCaption;
- FMainMemo.SaveEncoding := seUTF8WithoutBOM;
- if not IsReload then
- FMainMemo.Lines.Clear;
- FModifiedAnySinceLastCompile := True;
- FPreprocessorOutput := '';
- FIncludedFiles.Clear;
- UpdatePreprocMemos(IsReload);
- if not IsReload then
- FMainMemo.ClearUndo;
- FNavStacks.Clear;
- UpdateNavigationButtons;
- FCurrentNavItem.Invalidate;
- end;
- { Breakpoints are preserved on a per-file basis }
- procedure TMainForm.LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
- begin
- if AMemo.BreakPoints.Count <> 0 then
- raise Exception.Create('AMemo.BreakPoints.Count <> 0'); { NewMainFile or OpenFile should have cleared these }
- try
- var HadSkippedBreakPoint := False;
- var Strings := TStringList.Create;
- try
- LoadBreakPointLines(AMemo.FileName, Strings);
- for var LineAsString in Strings do begin
- var Line := LineAsString.ToInteger;
- if Line < AMemo.Lines.Count then
- AMemo.BreakPoints.Add(Line)
- else
- HadSkippedBreakPoint := True;
- end;
- finally
- Strings.Free;
- end;
- for var Line in AMemo.BreakPoints do
- UpdateLineMarkers(AMemo, Line);
- { If there were breakpoints beyond the end of file get rid of them so they
- don't magically reappear on a reload of an externally edited and grown
- file }
- if HadSkippedBreakPoint then
- BuildAndSaveBreakPointLines(AMemo);
- except
- { Ignore any exceptions }
- end;
- end;
- procedure TMainForm.BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
- begin
- try
- if AMemo.FileName <> '' then begin
- var Strings := TStringList.Create;
- try
- for var Line in AMemo.BreakPoints do
- Strings.Add(Line.ToString);
- SaveBreakPointLines(AMemo.FileName, Strings);
- finally
- Strings.Free;
- end;
- end;
- except
- { Handle exceptions locally; failure to save the breakpoint lines list should not be
- a fatal error }
- Application.HandleException(Self);
- end;
- end;
- { Known included and hidden files are preserved on a per-main-file basis }
- procedure TMainForm.LoadKnownIncludedAndHiddenFilesAndUpdateMemos;
- begin
- if FIncludedFiles.Count <> 0 then
- raise Exception.Create('FIncludedFiles.Count <> 0'); { NewMainFile should have cleared these }
- try
- if AFilename <> '' then begin
- var Strings := TStringList.Create;
- try
- LoadKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
- if Strings.Count > 0 then begin
- try
- for var Filename in Strings do begin
- var IncludedFile := TIncludedFile.Create;
- IncludedFile.Filename := Filename;
- IncludedFile.CompilerFileIndex := UnknownCompilerFileIndex;
- IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
- @IncludedFile.LastWriteTime);
- FIncludedFiles.Add(IncludedFile);
- end;
- finally
- UpdatePreprocMemos;
- end;
- end;
- finally
- Strings.Free;
- end;
- end;
- except
- { Ignore any exceptions }
- end;
- end;
- procedure TMainForm.BuildAndSaveKnownIncludedAndHiddenFiles;
- begin
- try
- if FMainMemo.FileName <> '' then begin
- var Strings := TStringList.Create;
- try
- for var IncludedFile in FIncludedFiles do
- Strings.Add(IncludedFile.Filename);
- SaveKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
- finally
- Strings.Free;
- end;
- end;
- except
- { Handle exceptions locally; failure to save the includes list should not be
- a fatal error }
- Application.HandleException(Self);
- end;
- end;
- procedure TMainForm.NewMainFileUsingWizard;
- var
- WizardForm: TWizardForm;
- SaveEnabled: Boolean;
- begin
- WizardForm := TWizardForm.Create(Application);
- try
- SaveEnabled := Enabled;
- if CommandLineWizard then begin
- WizardForm.WizardName := CommandLineWizardName;
- { Must disable MainForm even though it isn't shown, otherwise
- menu keyboard shortcuts (such as Ctrl+O) still work }
- Enabled := False;
- end;
- try
- if WizardForm.ShowModal <> mrOk then
- Exit;
- finally
- Enabled := SaveEnabled;
- end;
- if CommandLineWizard then begin
- SaveTextToFile(CommandLineFileName, WizardForm.ResultScript, seUTF8WithoutBOM);
- end else begin
- NewMainFile;
- FMainMemo.Lines.Text := WizardForm.ResultScript;
- FMainMemo.ClearUndo;
- if WizardForm.Result = wrComplete then begin
- FMainMemo.ForceModifiedState;
- if MsgBox('Would you like to compile the new script now?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
- BCompileClick(Self);
- end;
- end;
- finally
- WizardForm.Free;
- end;
- end;
- procedure TMainForm.OpenFile(AMemo: TIDEScintFileEdit; AFilename: String;
- const MainMemoAddToRecentDocs, IsReload: Boolean);
- function GetStreamSaveEncoding(const Stream: TStream): TSaveEncoding;
- var
- Buf: array[0..2] of Byte;
- begin
- Result := seAuto;
- var StreamSize := Stream.Size;
- var CappedSize: Integer;
- if StreamSize > High(Integer) then
- CappedSize := High(Integer)
- else
- CappedSize := Integer(StreamSize);
- if (CappedSize >= SizeOf(Buf)) and (Stream.Read(Buf, SizeOf(Buf)) = SizeOf(Buf)) and
- (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then
- Result := seUTF8WithBOM
- else begin
- Stream.Seek(0, soFromBeginning);
- var S: AnsiString;
- SetLength(S, CappedSize);
- SetLength(S, Stream.Read(S[1], CappedSize));
- if DetectUTF8Encoding(S) in [etUSASCII, etUTF8] then
- Result := seUTF8WithoutBOM;
- end;
- end;
- function GetEncoding(const SaveEncoding: TSaveEncoding): TEncoding;
- begin
- if SaveEncoding in [seUTF8WithBOM, seUTF8WithoutBOM] then
- Result := TEncoding.UTF8
- else
- Result := nil;
- end;
- { Same as TStrings.LoadFromStream, except that it returns the loaded string }
- function LoadFromStream(const Stream: TStream; const Encoding: TEncoding): String;
- begin
- const Size = Stream.Size - Stream.Position;
- var Buffer: TBytes;
- SetLength(Buffer, Size);
- Stream.Read(Buffer, 0, Size);
- var BufferEncoding := Encoding;
- const PreambleSize = TEncoding.GetBufferEncoding(Buffer, BufferEncoding, TEncoding.Default);
- Result := BufferEncoding.GetString(Buffer, PreambleSize, Length(Buffer) - PreambleSize);
- end;
- type
- TFilePosition = record
- Selection: TScintCaretAndAnchor;
- ScrollPosition: Integer;
- end;
- { See SciTEBase::CheckReload }
- function GetFilePosition(const AMemo: TScintEdit): TFilePosition;
- begin
- Result.Selection.CaretPos := AMemo.CaretPosition;
- Result.Selection.AnchorPos := AMemo.AnchorPosition;
- Result.ScrollPosition := AMemo.GetDocLineFromVisibleLine(AMemo.TopLine);
- end;
- { See SciTEBase::CheckReload }
- procedure DisplayAround(const AMemo: TScintEdit; const FilePosition: TFilePosition);
- begin
- AMemo.Call(SCI_SETSEL, FilePosition.Selection.AnchorPos, FilePosition.Selection.CaretPos);
- const CurTop = AMemo.TopLine;
- const LineTop = AMemo.GetVisibleLineFromDocLine(FilePosition.ScrollPosition);
- AMemo.Call(SCI_LINESCROLL, 0, LineTop - CurTop);
- AMemo.ChooseCaretX;
- end;
- var
- Stream: TFileStream;
- begin
- AMemo.OpeningFile := True;
- try
- AFilename := PathExpand(AFilename);
- const NameChange = PathCompare(AMemo.Filename, AFilename) <> 0;
- const FilePosition = GetFilePosition(AMemo);
- if IsReload then
- AMemo.BeginUndoAction;
- Stream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
- try
- if AMemo = FMainMemo then
- NewMainFile(IsReload)
- else begin
- AMemo.BreakPoints.Clear;
- if DestroyLineState(AMemo) then
- UpdateAllMemoLineMarkers(AMemo);
- if NameChange then { Also see below the other case which needs to be done after load }
- RemoveMemoFromNavigation(AMemo);
- end;
- GetFileTime(Stream.Handle, nil, nil, @AMemo.FileLastWriteTime);
- AMemo.SaveEncoding := GetStreamSaveEncoding(Stream);
- Stream.Seek(0, soFromBeginning);
- const TextStr = LoadFromStream(Stream, GetEncoding(AMemo.SaveEncoding));
- if IsReload and (AMemo.ChangeHistory <> schDisabled) then begin
- { Workaround to minimize change history on reload }
- AMemo.Call(SCI_TARGETWHOLEDOCUMENT, 0, 0);
- const RawTextStr = AMemo.ConvertStringToRawString(TextStr);
- AMemo.Call(SCI_REPLACETARGETMINIMAL, Length(RawTextStr), RawTextStr);
- end else
- AMemo.Lines.Text := TextStr;
- if (AMemo <> FMainMemo) and not NameChange then
- RemoveMemoBadLinesFromNavigation(AMemo);
- finally
- Stream.Free;
- if IsReload then
- AMemo.EndUndoAction;
- end;
- if IsReload then begin
- DisplayAround(AMemo, FilePosition);
- AMemo.SetSavePoint;
- end else
- AMemo.ClearUndo;
- if AMemo = FMainMemo then begin
- AMemo.Filename := AFilename;
- UpdateCaption;
- ModifyMRUMainFilesList(AFilename, True);
- if MainMemoAddToRecentDocs then
- AddFileToRecentDocs(AFilename);
- LoadKnownIncludedAndHiddenFilesAndUpdateMemos(AFilename);
- InvalidateStatusPanel(spHiddenFilesCount);
- end;
- LoadBreakPointLinesAndUpdateLineMarkers(AMemo);
- finally
- AMemo.OpeningFile := False;
- end;
- end;
- procedure TMainForm.OpenMRUMainFile(const AFilename: String);
- { Same as OpenFile, but offers to remove the file from the MRU list if it
- cannot be opened }
- begin
- try
- OpenFile(FMainMemo, AFilename, True);
- except
- Application.HandleException(Self);
- if MsgBoxFmt('There was an error opening the file. Remove it from the list?',
- [AFilename], SCompilerFormCaption, mbError, MB_YESNO) = IDYES then begin
- ModifyMRUMainFilesList(AFilename, False);
- DeleteBreakPointLines(AFilename);
- DeleteKnownIncludedAndHiddenFiles(AFilename);
- end;
- end;
- end;
- function TMainForm.SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
- procedure SaveMemoTo(const FN: String);
- var
- TempFN, BackupFN: String;
- Buf: array[0..4095] of Char;
- begin
- { Save to a temporary file; don't overwrite existing files in place. This
- way, if the system crashes or the disk runs out of space during the save,
- the existing file will still be intact. }
- if GetTempFileName(PChar(PathExtractDir(FN)), 'iss', 0, Buf) = 0 then
- raise Exception.CreateFmt('Error creating file (code %d). Could not save file',
- [GetLastError]);
- TempFN := Buf;
- try
- SaveTextToFile(TempFN, AMemo.Lines.Text, AMemo.SaveEncoding);
- { Back up existing file if needed }
- if FOptions.MakeBackups and NewFileExists(FN) then begin
- BackupFN := PathChangeExt(FN, '.~is');
- DeleteFile(BackupFN);
- if not RenameFile(FN, BackupFN) then
- raise Exception.Create('Error creating backup file. Could not save file');
- end;
- { Delete existing file }
- if not DeleteFile(FN) and (GetLastError <> ERROR_FILE_NOT_FOUND) then
- raise Exception.CreateFmt('Error removing existing file (code %d). Could not save file',
- [GetLastError]);
- except
- DeleteFile(TempFN);
- raise;
- end;
- { Rename temporary file.
- Note: This is outside the try..except because we already deleted the
- existing file, and don't want the temp file also deleted in the unlikely
- event that the rename fails. }
- if not RenameFile(TempFN, FN) then
- raise Exception.CreateFmt('Error renaming temporary file (code %d). Could not save file',
- [GetLastError]);
- GetLastWriteTimeOfFile(FN, @AMemo.FileLastWriteTime);
- end;
- var
- FN: String;
- begin
- Result := False;
- var OldName := AMemo.Filename;
- if SaveAs or (AMemo.Filename = '') then begin
- if AMemo <> FMainMemo then
- raise Exception.Create('Internal error: AMemo <> FMainMemo');
- FN := AMemo.Filename;
- if not NewGetSaveFileName('', FN, '', SCompilerOpenFilter, 'iss', Handle) then Exit;
- FN := PathExpand(FN);
- SaveMemoTo(FN);
- AMemo.Filename := FN;
- UpdateCaption;
- end else
- SaveMemoTo(AMemo.Filename);
- AMemo.SetSavePoint;
- if not FOptions.UndoAfterSave then
- AMemo.ClearUndo(False);
- Result := True;
- if AMemo = FMainMemo then begin
- ModifyMRUMainFilesList(AMemo.Filename, True);
- if PathCompare(AMemo.Filename, OldName) <> 0 then begin
- if OldName <> '' then begin
- DeleteBreakPointLines(OldName);
- DeleteKnownIncludedAndHiddenFiles(OldName);
- end;
- BuildAndSaveBreakPointLines(AMemo);
- BuildAndSaveKnownIncludedAndHiddenFiles;
- end;
- end;
- end;
- function TMainForm.ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
- function PromptToSaveMemo(const AMemo: TIDEScintFileEdit): Boolean;
- var
- FileTitle: String;
- begin
- Result := True;
- if AMemo.Modified then begin
- FileTitle := GetFileTitle(AMemo.Filename);
- case MsgBox('The text in the ' + FileTitle + ' file has changed.'#13#10#13#10 +
- 'Do you want to save the changes?', SCompilerFormCaption, mbError,
- MB_YESNOCANCEL) of
- IDYES: Result := SaveFile(AMemo, False);
- IDNO: ;
- else
- Result := False;
- end;
- end;
- end;
- var
- Memo: TIDEScintFileEdit;
- begin
- if FCompiling then begin
- MsgBox('Please stop the compile process before performing this command.',
- SCompilerFormCaption, mbError, MB_OK);
- Result := False;
- Exit;
- end;
- if FDebugging and not AskToDetachDebugger then begin
- Result := False;
- Exit;
- end;
- Result := True;
- if PromptToSave then begin
- for Memo in FFileMemos do begin
- if Memo.Used then begin
- Result := PromptToSaveMemo(Memo);
- if not Result then
- Exit;
- end;
- end;
- end;
- end;
- procedure TMainForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
- begin
- AddLines(CompilerOutputList, S, TObject(Kind), False, alpNone, 0);
- CompilerOutputList.Update;
- end;
- procedure TMainForm.DebugLogMessage(const S: String);
- begin
- AddLines(DebugOutputList, S, nil, True, alpTimestamp, FDebugLogListTimestampsWidth);
- DebugOutputList.Update;
- end;
- procedure TMainForm.DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
- begin
- DebugCallStackList.Clear;
- AddLines(DebugCallStackList, CallStack, nil, True, alpCountdown, FCallStackCount-1);
- DebugCallStackList.Items.Insert(0, '*** [Code] Call Stack');
- DebugCallStackList.Update;
- end;
- type
- PAppData = ^TAppData;
- TAppData = record
- Form: TMainForm;
- Filename: String;
- Lines: TStringList;
- CurLineNumber: Integer;
- CurLine: String;
- OutputExe: String;
- DebugInfo: Pointer;
- ErrorMsg: String;
- ErrorFilename: String;
- ErrorLine: Integer;
- Aborted: Boolean;
- end;
- function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
- AppData: Longint): Integer; stdcall;
- procedure DecodeIncludedFilenames(P: PChar; const IncludedFiles: TIncludedFiles;
- const AutoHideNew: Boolean; const HiddenFiles: TStringList);
- begin
- if P <> nil then begin
- var PrevIncludedFiles: TStringList := nil;
- try
- if AutoHideNew then begin
- PrevIncludedFiles := TStringList.Create;
- for var IncludedFile in IncludedFiles do
- PrevIncludedFiles.Add(IncludedFile.Filename);
- PrevIncludedFiles.UseLocale := False;
- PrevIncludedFiles.Sorted := True; { Just for lookup performance }
- end;
- IncludedFiles.Clear;
- var I := 0;
- while P^ <> #0 do begin
- if not IsISPPBuiltins(P) then begin
- const IncludedFile = TIncludedFile.Create;
- IncludedFile.Filename := GetCleanFileNameOfFile(P);
- IncludedFile.CompilerFileIndex := I;
- IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
- @IncludedFile.LastWriteTime);
- IncludedFiles.Add(IncludedFile);
- if AutoHideNew and (PrevIncludedFiles.IndexOf(IncludedFile.Filename) = -1) then begin
- { This is a new include file we didn't know about yet }
- if HiddenFiles.IndexOf(IncludedFile.Filename) = -1 then { Should always be True }
- HiddenFiles.Add(IncludedFile.Filename);
- end;
- end;
- Inc(P, StrLen(P) + 1);
- Inc(I);
- end;
- finally
- PrevIncludedFiles.Free;
- end;
- end else
- IncludedFiles.Clear;
- end;
- procedure CleanHiddenFiles(const IncludedFiles: TIncludedFiles; const HiddenFiles: TStringList);
- var
- HiddenFileIncluded: array of Boolean;
- begin
- if HiddenFiles.Count > 0 then begin
- { Clean previously hidden files which are no longer included }
- if IncludedFiles.Count > 0 then begin
- SetLength(HiddenFileIncluded, HiddenFiles.Count);
- for var I := 0 to HiddenFiles.Count-1 do
- HiddenFileIncluded[I] := False;
- for var I := 0 to IncludedFiles.Count-1 do begin
- var IncludedFile := IncludedFiles[I];
- var HiddenFileIndex := HiddenFiles.IndexOf(IncludedFile.Filename);
- if HiddenFileIndex <> -1 then
- HiddenFileIncluded[HiddenFileIndex] := True;
- end;
- for var I := HiddenFiles.Count-1 downto 0 do
- if not HiddenFileIncluded[I] then
- HiddenFiles.Delete(I);
- end else
- HiddenFiles.Clear;
- end;
- end;
- begin
- Result := iscrSuccess;
- with PAppData(AppData)^ do
- case Code of
- iscbReadScript:
- begin
- if Data.Reset then
- CurLineNumber := 0;
- if CurLineNumber < Lines.Count then begin
- CurLine := Lines[CurLineNumber];
- Data.LineRead := PChar(CurLine);
- Inc(CurLineNumber);
- end;
- end;
- iscbNotifyStatus:
- if Data.Warning then
- Form.StatusMessage(smkWarning, Data.StatusMsg)
- else
- Form.StatusMessage(smkNormal, Data.StatusMsg);
- iscbNotifyIdle:
- begin
- Form.UpdateCompileStatusPanels(Data.CompressProgress,
- Data.CompressProgressMax, Data.SecondsRemaining,
- Data.BytesCompressedPerSecond);
- { We have to use HandleMessage instead of ProcessMessages so that
- Application.Idle is called. Otherwise, Flat TSpeedButton's don't
- react to the mouse being moved over them.
- Unfortunately, HandleMessage by default calls WaitMessage. To avoid
- this we have an Application.OnIdle handler which sets Done to False
- while compiling is in progress - see AppOnIdle.
- The GetQueueStatus check below is just an optimization; calling
- HandleMessage when there are no messages to process wastes CPU. }
- if GetQueueStatus(QS_ALLINPUT) <> 0 then begin
- Form.FBecameIdle := False;
- repeat
- Application.HandleMessage;
- { AppOnIdle sets FBecameIdle to True when it's called, which
- indicates HandleMessage didn't find any message to process }
- until Form.FBecameIdle;
- end;
- if Form.FCompileWantAbort then
- Result := iscrRequestAbort;
- end;
- iscbNotifyPreproc:
- begin
- Form.FPreprocessorOutput := TrimRight(Data.PreprocessedScript);
- { Also stores last write time }
- DecodeIncludedFilenames(Data.IncludedFilenames, Form.FIncludedFiles,
- Form.FOptions.AutoHideNewIncludedFiles, Form.FHiddenFiles);
- CleanHiddenFiles(Form.FIncludedFiles, Form.FHiddenFiles);
- Form.InvalidateStatusPanel(spHiddenFilesCount);
- Form.BuildAndSaveKnownIncludedAndHiddenFiles;
- end;
- iscbNotifySuccess:
- begin
- OutputExe := Data.OutputExeFilename;
- if Form.FCompilerVersion.BinVersion >= $3000001 then begin
- DebugInfo := AllocMem(Data.DebugInfoSize);
- Move(Data.DebugInfo^, DebugInfo^, Data.DebugInfoSize);
- end else
- DebugInfo := nil;
- end;
- iscbNotifyError:
- begin
- if Assigned(Data.ErrorMsg) then
- ErrorMsg := Data.ErrorMsg
- else
- Aborted := True;
- ErrorFilename := Data.ErrorFilename;
- ErrorLine := Data.ErrorLine;
- end;
- end;
- end;
- procedure TMainForm.CompileFile(AFilename: String; const ReadFromFile: Boolean);
- function GetMemoFromErrorFilename(const ErrorFilename: String): TIDEScintFileEdit;
- var
- Memo: TIDEScintFileEdit;
- begin
- if ErrorFilename = '' then
- Result := FMainMemo
- else begin
- if FOptions.OpenIncludedFiles then begin
- for Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, ErrorFilename) = 0) then begin
- Result := Memo;
- Exit;
- end;
- end;
- end;
- Result := nil;
- end;
- end;
- var
- SourcePath, S, Options: String;
- Params: TCompileScriptParamsEx;
- AppData: TAppData;
- StartTime, ElapsedTime, ElapsedSeconds: DWORD;
- I: Integer;
- Memo: TIDEScintFileEdit;
- OldActiveMemo: TIDEScintEdit;
- begin
- if FCompiling then begin
- { Shouldn't get here, but just in case... }
- MsgBox('A compile is already in progress.', SCompilerFormCaption, mbError, MB_OK);
- Abort;
- end;
- if not ReadFromFile then begin
- if FOptions.OpenIncludedFiles then begin
- { Included files must always be saved since they're not read from the editor by the compiler }
- for Memo in FFileMemos do begin
- if (Memo <> FMainMemo) and Memo.Used and Memo.Modified then begin
- if FOptions.Autosave then begin
- if not SaveFile(Memo, False) then
- Abort;
- end else begin
- case MsgBox('The text in the ' + Memo.Filename + ' file has changed and must be saved before compiling.'#13#10#13#10 +
- 'Save the changes and continue?', SCompilerFormCaption, mbError,
- MB_YESNO) of
- IDYES:
- if not SaveFile(Memo, False) then
- Abort;
- else
- Abort;
- end;
- end;
- end;
- end;
- end;
- { Save main file if requested }
- if FOptions.Autosave and FMainMemo.Modified then begin
- if not SaveFile(FMainMemo, False) then
- Abort;
- end else if FMainMemo.Filename = '' then begin
- case MsgBox('Would you like to save the script before compiling?' +
- SNewLine2 + 'If you answer No, the compiled installation will be ' +
- 'placed under your My Documents folder by default.',
- SCompilerFormCaption, mbConfirmation, MB_YESNOCANCEL) of
- IDYES:
- if not SaveFile(FMainMemo, False) then
- Abort;
- IDNO: ;
- else
- Abort;
- end;
- end;
- AFilename := FMainMemo.Filename;
- end; {else: Command line compile, AFilename already set. }
- DestroyDebugInfo;
- OldActiveMemo := FActiveMemo;
- AppData.Lines := TStringList.Create;
- try
- FBuildAnimationFrame := 0;
- FProgress := 0;
- FProgressMax := 0;
- FTaskbarProgressValue := 0;
- FActiveMemo.CancelAutoCompleteAndCallTip;
- FActiveMemo.Cursor := crAppStart;
- FActiveMemo.SetCursorID(999); { hack to keep it from overriding Cursor }
- CompilerOutputList.Cursor := crAppStart;
- for Memo in FFileMemos do
- Memo.ReadOnly := True;
- UpdateEditModeStatusPanel;
- HideError;
- CompilerOutputList.Clear;
- SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugOutputList.Clear;
- SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugCallStackList.Clear;
- SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- OutputTabSet.TabIndex := tiCompilerOutput;
- SetStatusPanelVisible(True);
- SourcePath := GetSourcePath(AFilename);
- FillChar(Params, SizeOf(Params), 0);
- Params.Size := SizeOf(Params);
- Params.CompilerPath := nil;
- Params.SourcePath := PChar(SourcePath);
- Params.CallbackProc := CompilerCallbackProc;
- Pointer(Params.AppData) := @AppData;
- Options := '';
- for I := 0 to FSignTools.Count-1 do
- Options := Options + AddSignToolParam(FSignTools[I]);
- Params.Options := PChar(Options);
- AppData.Form := Self;
- AppData.CurLineNumber := 0;
- AppData.Aborted := False;
- I := ReadScriptLines(AppData.Lines, ReadFromFile, AFilename, FMainMemo);
- if I <> -1 then begin
- if not ReadFromFile then begin
- MoveCaretAndActivateMemo(FMainMemo, I, False);
- SetErrorLine(FMainMemo, I);
- end;
- raise Exception.CreateFmt(SCompilerIllegalNullChar, [I + 1]);
- end;
- StartTime := GetTickCount;
- StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)]));
- StatusMessage(smkStartEnd, '');
- FCompiling := True;
- FCompileWantAbort := False;
- UpdateRunMenu;
- UpdateCaption;
- SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
- AppData.Filename := AFilename;
- {$IFNDEF STATICCOMPILER}
- if ISDllCompileScript(Params) <> isceNoError then begin
- {$ELSE}
- if ISCompileScript(Params, False) <> isceNoError then begin
- {$ENDIF}
- StatusMessage(smkError, SCompilerStatusErrorAborted);
- if not ReadFromFile and (AppData.ErrorLine > 0) then begin
- Memo := GetMemoFromErrorFilename(AppData.ErrorFilename);
- if Memo <> nil then begin
- { Move the caret to the line number the error occurred on }
- MoveCaretAndActivateMemo(Memo, AppData.ErrorLine - 1, False);
- SetErrorLine(Memo, AppData.ErrorLine - 1);
- end;
- end;
- if not AppData.Aborted then begin
- S := '';
- if AppData.ErrorFilename <> '' then
- S := 'File: ' + AppData.ErrorFilename + SNewLine2;
- if AppData.ErrorLine > 0 then
- S := S + Format('Line %d:' + SNewLine, [AppData.ErrorLine]);
- S := S + AppData.ErrorMsg;
- SetAppTaskbarProgressState(tpsError);
- MsgBox(S, 'Compiler Error', mbCriticalError, MB_OK)
- end;
- Abort;
- end;
- ElapsedTime := GetTickCount - StartTime;
- ElapsedSeconds := ElapsedTime div 1000;
- StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
- Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, FormatSettings.TimeSeparator,
- ElapsedSeconds mod 60, FormatSettings.DecimalSeparator, ElapsedTime mod 1000])]));
- finally
- AppData.Lines.Free;
- FCompiling := False;
- SetLowPriority(False, FSavePriorityClass);
- OldActiveMemo.Cursor := crDefault;
- OldActiveMemo.SetCursorID(SC_CURSORNORMAL);
- CompilerOutputList.Cursor := crDefault;
- for Memo in FFileMemos do
- Memo.ReadOnly := False;
- UpdateEditModeStatusPanel;
- UpdateRunMenu;
- UpdateCaption;
- UpdatePreprocMemos;
- if AppData.DebugInfo <> nil then begin
- ParseDebugInfo(AppData.DebugInfo); { Must be called after UpdateIncludedFilesMemos }
- FreeMem(AppData.DebugInfo);
- end;
- InvalidateStatusPanel(spCompileIcon);
- InvalidateStatusPanel(spCompileProgress);
- SetAppTaskbarProgressState(tpsNoProgress);
- StatusBar.Panels[spExtraStatus].Text := '';
- end;
- FCompiledExe := AppData.OutputExe;
- FModifiedAnySinceLastCompile := False;
- FModifiedAnySinceLastCompileAndGo := False;
- end;
- procedure TMainForm.SyncEditorOptions;
- const
- SquigglyStyles: array[Boolean] of Integer = (INDIC_HIDDEN, INDIC_SQUIGGLE);
- WhiteSpaceStyles: array[Boolean] of Integer = (SCWS_INVISIBLE, SCWS_VISIBLEALWAYS);
- var
- Memo: TIDEScintEdit;
- begin
- for Memo in FMemos do begin
- Memo.UseStyleAttributes := FOptions.UseSyntaxHighlighting;
- Memo.Call(SCI_INDICSETSTYLE, minSquiggly, SquigglyStyles[FOptions.UnderlineErrors]);
- Memo.Call(SCI_SETVIEWWS, WhiteSpaceStyles[FOptions.ShowWhiteSpace], 0);
- if FOptions.CursorPastEOL then
- Memo.VirtualSpaceOptions := [svsRectangularSelection, svsUserAccessible, svsNoWrapLineStart]
- else
- Memo.VirtualSpaceOptions := [];
- Memo.FillSelectionToEdge := FOptions.CursorPastEOL;
- Memo.TabWidth := FOptions.TabWidth;
- Memo.UseTabCharacter := FOptions.UseTabCharacter;
- Memo.KeyMappingType := FOptions.MemoKeyMappingType;
- if Memo = FMainMemo then begin
- SetFakeShortCut(ESelectNextOccurrence, FMainMemo.GetComplexCommandShortCut(ccSelectNextOccurrence));
- SetFakeShortCut(ESelectAllOccurrences, FMainMemo.GetComplexCommandShortCut(ccSelectAllOccurrences));
- SetFakeShortCut(ESelectAllFindMatches, FMainMemo.GetComplexCommandShortCut(ccSelectAllFindMatches));
- SetFakeShortCut(EFoldLine, FMainMemo.GetComplexCommandShortCut(ccFoldLine));
- SetFakeShortCut(EUnfoldLine, FMainMemo.GetComplexCommandShortCut(ccUnfoldLine));
- SetFakeShortCut(EToggleLinesComment, FMainMemo.GetComplexCommandShortCut(ccToggleLinesComment));
- SetFakeShortCut(EBraceMatch, FMainMemo.GetComplexCommandShortCut(ccBraceMatch));
- end;
- Memo.UseFolding := FOptions.UseFolding;
- Memo.WordWrap := FOptions.WordWrap;
- if FOptions.IndentationGuides then
- Memo.IndentationGuides := sigLookBoth
- else
- Memo.IndentationGuides := sigNone;
- Memo.LineNumbers := FOptions.GutterLineNumbers;
- end;
- end;
- procedure TMainForm.FMenuClick(Sender: TObject);
- begin
- UpdateFileMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.FNewMainFileClick(Sender: TObject);
- begin
- if ConfirmCloseFile(True) then
- NewMainFile;
- end;
- procedure TMainForm.FNewMainFileUserWizardClick(Sender: TObject);
- begin
- if ConfirmCloseFile(True) then
- NewMainFileUsingWizard;
- end;
- procedure TMainForm.ShowOpenMainFileDialog(const Examples: Boolean);
- var
- InitialDir, FileName: String;
- begin
- if Examples then begin
- InitialDir := PathExtractPath(NewParamStr(0)) + 'Examples';
- Filename := PathExtractPath(NewParamStr(0)) + 'Examples\Example1.iss';
- end
- else begin
- InitialDir := PathExtractDir(FMainMemo.Filename);
- Filename := '';
- end;
- if ConfirmCloseFile(True) then
- if NewGetOpenFileName('', FileName, InitialDir, SCompilerOpenFilter, 'iss', Handle) then
- OpenFile(FMainMemo, Filename, False);
- end;
- procedure TMainForm.FOpenMainFileClick(Sender: TObject);
- begin
- ShowOpenMainFileDialog(False);
- end;
- procedure TMainForm.FSaveClick(Sender: TObject);
- begin
- SaveFile((FActiveMemo as TIDEScintFileEdit), Sender = FSaveMainFileAs);
- end;
- procedure TMainForm.FSaveEncodingItemClick(Sender: TObject);
- begin
- var Memo := (FActiveMemo as TIDEScintFileEdit);
- var OldSaveEncoding := Memo.SaveEncoding;
- if Sender = FSaveEncodingUTF8WithBOM then
- Memo.SaveEncoding := seUTF8WithBOM
- else if Sender = FSaveEncodingUTF8WithoutBOM then
- Memo.SaveEncoding := seUTF8WithoutBOM
- else
- Memo.SaveEncoding := seAuto;
- if Memo.SaveEncoding <> OldSaveEncoding then
- Memo.ForceModifiedState;
- end;
- procedure TMainForm.FSaveAllClick(Sender: TObject);
- var
- Memo: TIDEScintFileEdit;
- begin
- for Memo in FFileMemos do
- if Memo.Used and Memo.Modified then
- SaveFile(Memo, False);
- end;
- procedure TMainForm.FPrintClick(Sender: TObject);
- procedure SetupNonDarkPrintStyler(var PrintStyler: TInnoSetupStyler; var PrintTheme: TTheme;
- var OldStyler: TScintCustomStyler; var OldTheme: TTheme);
- begin
- { Not the most pretty code, would ideally make a copy of FActiveMemo and print that instead or
- somehow convince Scintilla to use different print styles but don't know of a good way to do
- either. Using SC_PRINT_COLOURONWHITE doesn't help, this gives white on white in dark mode. }
- PrintStyler := TInnoSetupStyler.Create(nil);
- PrintTheme := TTheme.Create;
- PrintStyler.ISPPInstalled := ISPPInstalled;
- PrintStyler.Theme := PrintTheme;
- if not FTheme.Dark then
- PrintTheme.Typ := FTheme.Typ
- else
- PrintTheme.Typ := ttModernLight;
- OldStyler := FActiveMemo.Styler;
- OldTheme := FActiveMemo.Theme;
- FActiveMemo.Styler := PrintStyler;
- FActiveMemo.Theme := PrintTheme;
- FActiveMemo.UpdateThemeColorsAndStyleAttributes;
- end;
- procedure DeinitPrintStyler(const PrintStyler: TInnoSetupStyler; const PrintTheme: TTheme;
- const OldStyler: TScintCustomStyler; const OldTheme: TTheme);
- begin
- if (OldStyler <> nil) or (OldTheme <> nil) then begin
- if OldStyler <> nil then
- FActiveMemo.Styler := OldStyler;
- if OldTheme <> nil then
- FActiveMemo.Theme := OldTheme;
- FActiveMemo.UpdateThemeColorsAndStyleAttributes;
- end;
- if PrintTheme <> FTheme then
- PrintTheme.Free;
- PrintStyler.Free;
- end;
- var
- PrintStyler: TInnoSetupStyler;
- OldStyler: TScintCustomStyler;
- PrintTheme, OldTheme: TTheme;
- PrintMemo: TIDEScintEdit;
- HeaderMemo: TIDEScintFileEdit;
- FileTitle, S: String;
- pdlg: TPrintDlg;
- hdc: Windows.HDC;
- rectMargins, rectPhysMargins, rectSetup, rcw: TRect;
- ptPage, ptDpi: TPoint;
- headerLineHeight, footerLineHeight: Integer;
- fontHeader, fontFooter: HFONT;
- tm: TTextMetric;
- di: TDocInfo;
- lengthDoc, lengthDocMax, lengthPrinted: Integer;
- frPrint: TScintRangeToFormat;
- pageNum: Integer;
- printPage: Boolean;
- ta: UINT;
- sHeader, sFooter: String;
- pen, penOld: HPEN;
- begin
- if FActiveMemo is TIDEScintFileEdit then
- HeaderMemo := TIDEScintFileEdit(FActiveMemo)
- else
- HeaderMemo := FMainMemo;
- sHeader := HeaderMemo.Filename;
- FileTitle := GetFileTitle(HeaderMemo.Filename);
- if HeaderMemo <> FActiveMemo then begin
- S := ' - ' + MemosTabSet.Tabs[MemoToTabIndex(FActiveMemo)];
- sHeader := Format('%s %s', [sHeader, S]);
- FileTitle := Format('%s %s', [FileTitle, S]);
- end;
- sHeader := Format('%s - %s', [sHeader, DateTimeToStr(Now())]);
- { Based on SciTE 5.50's SciTEWin::Print }
-
- ZeroMemory(@pdlg, SizeOf(pdlg));
- pdlg.lStructSize := SizeOf(pdlg);
- pdlg.hwndOwner := Handle;
- pdlg.hInstance := hInstance;
- pdlg.Flags := PD_USEDEVMODECOPIES or PD_ALLPAGES or PD_RETURNDC;
- pdlg.nFromPage := 1;
- pdlg.nToPage := 1;
- pdlg.nMinPage := 1;
- pdlg.nMaxPage := $ffff; // We do not know how many pages in the document until the printer is selected and the paper size is known.
- pdlg.nCopies := 1;
- pdlg.hDC := 0;
- pdlg.hDevMode := FDevMode;
- pdlg.hDevNames := FDevNames;
- // See if a range has been selected
- var rangeSelection := FActiveMemo.Selection;
- if rangeSelection.StartPos = rangeSelection.EndPos then
- pdlg.Flags := pdlg.Flags or PD_NOSELECTION
- else
- pdlg.Flags := pdlg.Flags or PD_SELECTION;
- if not PrintDlg(pdlg) then
- Exit;
- PrintStyler := nil;
- PrintTheme := nil;
- OldStyler := nil;
- OldTheme := nil;
- try
- if FTheme.Dark then
- SetupNonDarkPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme)
- else
- PrintTheme := FTheme;
- FDevMode := pdlg.hDevMode;
- FDevNames := pdlg.hDevNames;
- hdc := pdlg.hDC;
- // Get printer resolution
- ptDpi.x := GetDeviceCaps(hdc, LOGPIXELSX); // dpi in X direction
- ptDpi.y := GetDeviceCaps(hdc, LOGPIXELSY); // dpi in Y direction
- // Start by getting the physical page size (in device units).
- ptPage.x := GetDeviceCaps(hdc, PHYSICALWIDTH); // device units
- ptPage.y := GetDeviceCaps(hdc, PHYSICALHEIGHT); // device units
- // Get the dimensions of the unprintable
- // part of the page (in device units).
- rectPhysMargins.left := GetDeviceCaps(hdc, PHYSICALOFFSETX);
- rectPhysMargins.top := GetDeviceCaps(hdc, PHYSICALOFFSETY);
- // To get the right and lower unprintable area,
- // we take the entire width and height of the paper and
- // subtract everything else.
- rectPhysMargins.right := ptPage.x // total paper width
- - GetDeviceCaps(hdc, HORZRES) // printable width
- - rectPhysMargins.left; // left unprintable margin
- rectPhysMargins.bottom := ptPage.y // total paper height
- - GetDeviceCaps(hdc, VERTRES) // printable height
- - rectPhysMargins.top; // right unprintable margin
- // At this point, rectPhysMargins contains the widths of the
- // unprintable regions on all four sides of the page in device units.
- (*
- // Take in account the page setup given by the user (if one value is not null)
- if (pagesetupMargin.left != 0 || pagesetupMargin.right != 0 ||
- pagesetupMargin.top != 0 || pagesetupMargin.bottom != 0) {
- GUI::Rectangle rectSetup;
- // Convert the hundredths of millimeters (HiMetric) or
- // thousandths of inches (HiEnglish) margin values
- // from the Page Setup dialog to device units.
- // (There are 2540 hundredths of a mm in an inch.)
- TCHAR localeInfo[3];
- GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, localeInfo, 3);
- if (localeInfo[0] == '0') { // Metric system. '1' is US System *)
- rectSetup.left := MulDiv(500 {pagesetupMargin.left}, ptDpi.x, 2540);
- rectSetup.top := MulDiv(500 {pagesetupMargin.top}, ptDpi.y, 2540);
- rectSetup.right := MulDiv(500 {pagesetupMargin.right}, ptDpi.x, 2540);
- rectSetup.bottom := MulDiv(500 {pagesetupMargin.bottom}, ptDpi.y, 2540);
- (* } else {
- rectSetup.left = MulDiv(pagesetupMargin.left, ptDpi.x, 1000);
- rectSetup.top = MulDiv(pagesetupMargin.top, ptDpi.y, 1000);
- rectSetup.right = MulDiv(pagesetupMargin.right, ptDpi.x, 1000);
- rectSetup.bottom = MulDiv(pagesetupMargin.bottom, ptDpi.y, 1000);
- } *)
- // Don't reduce margins below the minimum printable area
- rectMargins.left := Max(rectPhysMargins.left, rectSetup.left);
- rectMargins.top := Max(rectPhysMargins.top, rectSetup.top);
- rectMargins.right := Max(rectPhysMargins.right, rectSetup.right);
- rectMargins.bottom := Max(rectPhysMargins.bottom, rectSetup.bottom);
- (*
- } else {
- rectMargins := rectPhysMargins;
- }
- *)
- // rectMargins now contains the values used to shrink the printable
- // area of the page.
- // Convert device coordinates into logical coordinates
- DPtoLP(hdc, rectMargins, 2);
- DPtoLP(hdc, rectPhysMargins, 2);
- // Convert page size to logical units and we're done!
- DPtoLP(hdc, ptPage, 1);
- headerLineHeight := MulDiv(9, ptDpi.y, 72);
- fontHeader := CreateFont(headerLineHeight, 0, 0, 0, FW_REGULAR, 1, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
- SelectObject(hdc, fontHeader);
- GetTextMetrics(hdc, &tm);
- headerLineHeight := tm.tmHeight + tm.tmExternalLeading;
- footerLineHeight := MulDiv(9, ptDpi.y, 72);
- fontFooter := CreateFont(footerLineHeight, 0, 0, 0, FW_REGULAR, 0, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
- SelectObject(hdc, fontFooter);
- GetTextMetrics(hdc, &tm);
- footerLineHeight := tm.tmHeight + tm.tmExternalLeading;
- ZeroMemory(@di, SizeOf(di));
- di.cbSize := SizeOf(di);
- di.lpszDocName := PChar(FileTitle);
- di.lpszOutput := nil;
- di.lpszDatatype := nil;
- di.fwType := 0;
- if StartDoc(hdc, &di) < 0 then begin
- DeleteDC(hdc);
- DeleteObject(fontHeader);
- DeleteObject(fontFooter);
- MsgBox('Can not start printer document.', SCompilerFormCaption, mbError, MB_OK);
- Exit;
- end;
- lengthDocMax := FActiveMemo.GetRawTextLength;
- // PD_SELECTION -> requested to print selection.
- lengthDoc := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.EndPos, lengthDocMax);
- lengthPrinted := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.StartPos, 0);
- // We must subtract the physical margins from the printable area
- frPrint.hdc := hdc;
- frPrint.hdcTarget := hdc;
- frPrint.rc.left := rectMargins.left - rectPhysMargins.left;
- frPrint.rc.top := rectMargins.top - rectPhysMargins.top;
- frPrint.rc.right := ptPage.x - rectMargins.right - rectPhysMargins.left;
- frPrint.rc.bottom := ptPage.y - rectMargins.bottom - rectPhysMargins.top;
- frPrint.rcPage.left := 0;
- frPrint.rcPage.top := 0;
- frPrint.rcPage.right := ptPage.x - rectPhysMargins.left - rectPhysMargins.right - 1;
- frPrint.rcPage.bottom := ptPage.y - rectPhysMargins.top - rectPhysMargins.bottom - 1;
- frPrint.rc.top := frPrint.rc.top + headerLineHeight + headerLineHeight div 2;
- frPrint.rc.bottom := frPrint.rc.bottom - (footerLineHeight + footerLineHeight div 2);
- // Print each page
- pageNum := 1;
- while lengthPrinted < lengthDoc do begin
- printPage := ((pdlg.Flags and PD_PAGENUMS) = 0) or
- ((pageNum >= pdlg.nFromPage) and (pageNum <= pdlg.nToPage));
- sFooter := Format('- %d -', [pageNum]);
- if printPage then begin
- StartPage(hdc);
- SetTextColor(hdc, PrintTheme.Colors[tcFore]);
- SetBkColor(hdc, PrintTheme.Colors[tcBack]);
- SelectObject(hdc, fontHeader);
- ta := SetTextAlign(hdc, TA_BOTTOM);
- rcw := Rect(frPrint.rc.left, frPrint.rc.top - headerLineHeight - headerLineHeight div 2,
- frPrint.rc.right, frPrint.rc.top - headerLineHeight div 2);
- rcw.bottom := rcw.top + headerLineHeight;
- ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.top - headerLineHeight div 2,
- ETO_OPAQUE, rcw, sHeader, Length(sHeader), nil);
- SetTextAlign(hdc, ta);
- pen := CreatePen(0, 1, GetTextColor(hdc));
- penOld := SelectObject(hdc, pen);
- MoveToEx(hdc, frPrint.rc.left, frPrint.rc.top - headerLineHeight div 4, nil);
- LineTo(hdc, frPrint.rc.right, frPrint.rc.top - headerLineHeight div 4);
- SelectObject(hdc, penOld);
- DeleteObject(pen);
- end;
- frPrint.chrg.StartPos := lengthPrinted;
- frPrint.chrg.EndPos := lengthDoc;
- lengthPrinted := FActiveMemo.FormatRange(printPage, @frPrint);
- if printPage then begin
- SetTextColor(hdc, PrintTheme.Colors[tcFore]);
- SetBkColor(hdc, PrintTheme.Colors[tcBack]);
- SelectObject(hdc, fontFooter);
- ta := SetTextAlign(hdc, TA_TOP);
- rcw := Rect(frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 2,
- frPrint.rc.right, frPrint.rc.bottom + footerLineHeight + footerLineHeight div 2);
- ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.bottom + footerLineHeight div 2,
- ETO_OPAQUE, rcw, sFooter, Length(sFooter), nil);
- SetTextAlign(hdc, ta);
- pen := CreatePen(0, 1, GetTextColor(hdc));
- penOld := SelectObject(hdc, pen);
- MoveToEx(hdc, frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 4, nil);
- LineTo(hdc, frPrint.rc.right, frPrint.rc.bottom + footerLineHeight div 4);
- SelectObject(hdc, penOld);
- DeleteObject(pen);
- EndPage(hdc);
- end;
- Inc(pageNum);
- if ((pdlg.Flags and PD_PAGENUMS) <> 0) and (pageNum > pdlg.nToPage) then
- Break;
- end;
- FActiveMemo.FormatRange(False, nil);
- EndDoc(hdc);
- DeleteDC(hdc);
- DeleteObject(fontHeader);
- DeleteObject(fontFooter);
- finally
- DeinitPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme);
- end;
- end;
- procedure TMainForm.FClearRecentClick(Sender: TObject);
- begin
- if MsgBox('Are you sure you want to clear the list of recently opened files?',
- SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
- ClearMRUMainFilesList;
- end;
- procedure TMainForm.FMRUClick(Sender: TObject);
- var
- I: Integer;
- begin
- if ConfirmCloseFile(True) then
- for I := 0 to High(FMRUMainFilesMenuItems) do
- if FMRUMainFilesMenuItems[I] = Sender then begin
- OpenMRUMainFile(FMRUMainFilesList[I]);
- Break;
- end;
- end;
- procedure TMainForm.FExitClick(Sender: TObject);
- begin
- Close;
- end;
- procedure TMainForm.EMenuClick(Sender: TObject);
- begin
- UpdateEditMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.EUndoClick(Sender: TObject);
- begin
- FActiveMemo.Undo;
- end;
- procedure TMainForm.ERedoClick(Sender: TObject);
- begin
- FActiveMemo.Redo;
- end;
- procedure TMainForm.ECutClick(Sender: TObject);
- begin
- FActiveMemo.CutToClipboard;
- end;
- procedure TMainForm.ECopyClick(Sender: TObject);
- begin
- FActiveMemo.CopyToClipboard;
- end;
- procedure TMainForm.EPasteClick(Sender: TObject);
- begin
- if not MultipleSelectionPasteFromClipboard(FActiveMemo) then
- FActiveMemo.PasteFromClipboard;
- end;
- procedure TMainForm.EDeleteClick(Sender: TObject);
- begin
- FActiveMemo.ClearSelection;
- end;
- procedure TMainForm.ESelectAllClick(Sender: TObject);
- begin
- FActiveMemo.SelectAll;
- end;
- procedure TMainForm.ESelectAllOccurrencesClick(Sender: TObject);
- begin
- { Might be called even if ESelectAllOccurrences.Enabled would be False in EMenuClick }
- if FActiveMemo.SelEmpty then begin
- { If the selection is empty then SelectAllOccurrences will actually just select
- the word at caret which is not what we want, so preselect this word ourselves }
- var Range := FActiveMemo.WordAtCaretRange;
- if Range.StartPos <> Range.EndPos then
- FActiveMemo.SetSingleSelection(Range.EndPos, Range.StartPos);
- end;
- FActiveMemo.SelectAllOccurrences([sfoMatchCase]);
- end;
- procedure TMainForm.ESelectNextOccurrenceClick(Sender: TObject);
- begin
- { Might be called even if ESelectNextOccurrence.Enabled would be False in EMenuClick }
- FActiveMemo.SelectNextOccurrence([sfoMatchCase]);
- end;
- procedure TMainForm.EToggleLinesCommentClick(Sender: TObject);
- begin
- ToggleLinesComment(FActiveMemo);
- end;
- procedure TMainForm.EBraceMatchClick(Sender: TObject);
- begin
- FActiveMemo.BraceMatch;
- end;
- procedure TMainForm.ESelectAllFindMatchesClick(Sender: TObject);
- begin
- { Might be called even if ESelectAllFindMatches.Enabled would be False in EMenuClick }
- if FLastFindText <> '' then
- SelectAllFindMatches(FActiveMemo);
- end;
- procedure TMainForm.VMenuClick(Sender: TObject);
- begin
- UpdateViewMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.VNextTabClick(Sender: TObject);
- var
- NewTabIndex: Integer;
- begin
- NewTabIndex := MemosTabSet.TabIndex+1;
- if NewTabIndex >= MemosTabSet.Tabs.Count then
- NewTabIndex := 0;
- MemosTabSet.TabIndex := NewTabIndex;
- end;
- procedure TMainForm.VPreviousTabClick(Sender: TObject);
- var
- NewTabIndex: Integer;
- begin
- NewTabIndex := MemosTabSet.TabIndex-1;
- if NewTabIndex < 0 then
- NewTabIndex := MemosTabSet.Tabs.Count-1;
- MemosTabSet.TabIndex := NewTabIndex;
- end;
- procedure TMainForm.CloseTab(const TabIndex: Integer);
- begin
- var Memo := TabIndexToMemo(TabIndex, MemosTabSet.Tabs.Count-1);
- var MemoWasActiveMemo := Memo = FActiveMemo;
- MemosTabSet.Tabs.Delete(TabIndex); { This will not change MemosTabset.TabIndex }
- MemosTabSet.Hints.Delete(TabIndex);
- MemosTabSet.CloseButtons.Delete(TabIndex);
- FHiddenFiles.Add((Memo as TIDEScintFileEdit).Filename);
- InvalidateStatusPanel(spHiddenFilesCount);
- BuildAndSaveKnownIncludedAndHiddenFiles;
- { Because MemosTabSet.Tabs and FHiddenFiles have both been updated now,
- hereafter setting TabIndex will not select the memo we're closing
- even if it's not hidden yet because TabIndexToMemo as called by
- MemosTabSetClick will skip it }
- if MemoWasActiveMemo then begin
- if MemosTabSet.Tabs.Count > 1 then begin
- { Select next tab, except when we're already at the end. Avoiding flicker by
- doing this before hiding old active memo. We do this in a dirty way by
- clicking two tabs while making sure TabSetClick doesn't see the first
- 'fake' one. }
- FIgnoreTabSetClick := True;
- try
- VNextTabClick(Self);
- finally
- FIgnoreTabSetClick := False;
- end;
- VPreviousTabClick(Self);
- end else
- MemosTabSet.TabIndex := 0;
- Memo.CancelAutoCompleteAndCallTip;
- Memo.Visible := False;
- end else if TabIndex < MemosTabset.TabIndex then
- MemosTabSet.TabIndex := MemosTabset.TabIndex-1; { Reselect old selected tab }
- end;
- procedure TMainForm.VCloseCurrentTabClick(Sender: TObject);
- begin
- CloseTab(MemosTabSet.TabIndex);
- end;
- procedure TMainForm.ReopenTabOrTabs(const HiddenFileIndex: Integer;
- const Activate: Boolean);
- begin
- var ReopenFilename: String;
- if HiddenFileIndex >= 0 then begin
- ReopenFilename := FHiddenFiles[HiddenFileIndex];
- FHiddenFiles.Delete(HiddenFileIndex);
- end else begin
- ReopenFilename := FHiddenFiles[0];
- FHiddenFiles.Clear;
- end;
- InvalidateStatusPanel(spHiddenFilesCount);
- UpdatePreprocMemos;
- BuildAndSaveKnownIncludedAndHiddenFiles;
- { Activate the memo if requested }
- if Activate then begin
- for var Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, ReopenFilename) = 0) then begin
- MemosTabSet.TabIndex := MemoToTabIndex(memo);
- Break;
- end;
- end
- end;
- end;
- procedure TMainForm.ReopenTabClick(Sender: TObject);
- begin
- ReopenTabOrTabs((Sender as TMenuItem).Tag, True);
- end;
- procedure TMainForm.VReopenTabsClick(Sender: TObject);
- begin
- ReopenTabOrTabs(-1, True);
- end;
- procedure TMainForm.VZoomInClick(Sender: TObject);
- begin
- FActiveMemo.ZoomIn; { MemoZoom will zoom the other memos }
- end;
- procedure TMainForm.VZoomOutClick(Sender: TObject);
- begin
- FActiveMemo.ZoomOut;
- end;
- procedure TMainForm.VZoomResetClick(Sender: TObject);
- begin
- FActiveMemo.Zoom := 0;
- end;
- procedure TMainForm.VToolbarClick(Sender: TObject);
- begin
- ToolbarPanel.Visible := not ToolbarPanel.Visible;
- end;
- procedure TMainForm.VStatusBarClick(Sender: TObject);
- begin
- StatusBar.Visible := not StatusBar.Visible;
- end;
- procedure TMainForm.VWordWrapClick(Sender: TObject);
- begin
- FOptions.WordWrap := not FOptions.WordWrap;
- SyncEditorOptions;
- var Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'WordWrap', FOptions.WordWrap);
- finally
- Ini.Free;
- end;
- end;
- procedure TMainForm.SetStatusPanelVisible(const AVisible: Boolean);
- var
- CaretWasInView: Boolean;
- begin
- if StatusPanel.Visible <> AVisible then begin
- CaretWasInView := FActiveMemo.IsPositionInViewVertically(FActiveMemo.CaretPosition);
- if AVisible then begin
- { Ensure the status panel height isn't out of range before showing }
- UpdateStatusPanelHeight(StatusPanel.Height);
- SplitPanel.Top := ClientHeight;
- StatusPanel.Top := ClientHeight;
- end
- else begin
- if StatusPanel.ContainsControl(ActiveControl) then
- ActiveControl := FActiveMemo;
- end;
- SplitPanel.Visible := AVisible;
- StatusPanel.Visible := AVisible;
- if AVisible and CaretWasInView then begin
- { If the caret was in view, make sure it still is }
- FActiveMemo.ScrollCaretIntoView;
- end;
- end;
- end;
- procedure TMainForm.VHideClick(Sender: TObject);
- begin
- SetStatusPanelVisible(False);
- end;
- procedure TMainForm.VCompilerOutputClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiCompilerOutput;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.VDebugOutputClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiDebugOutput;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.VDebugCallStackClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiDebugCallStack;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.VFindResultsClick(Sender: TObject);
- begin
- OutputTabSet.TabIndex := tiFindResults;
- SetStatusPanelVisible(True);
- end;
- procedure TMainForm.BMenuClick(Sender: TObject);
- begin
- UpdateBuildMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.BCompileClick(Sender: TObject);
- begin
- CompileFile('', False);
- end;
- procedure TMainForm.BStopCompileClick(Sender: TObject);
- begin
- SetAppTaskbarProgressState(tpsPaused);
- try
- if MsgBox('Are you sure you want to abort the compile?', SCompilerFormCaption,
- mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
- FCompileWantAbort := True;
- finally
- SetAppTaskbarProgressState(tpsNormal);
- end;
- end;
- procedure TMainForm.BLowPriorityClick(Sender: TObject);
- begin
- FOptions.LowPriorityDuringCompile := not FOptions.LowPriorityDuringCompile;
- { If a compile is already in progress, change the priority now }
- if FCompiling then
- SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
- end;
- procedure TMainForm.BOpenOutputFolderClick(Sender: TObject);
- begin
- LaunchFileOrURL(AddBackslash(GetSystemWinDir) + 'explorer.exe',
- Format('/select,"%s"', [FCompiledExe]));
- end;
- procedure TMainForm.HMenuClick(Sender: TObject);
- begin
- UpdateHelpMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.HPurchaseClick(Sender: TObject);
- begin
- if IsLicensed then
- 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.',
- SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
- ClipBoard.AsText := GetChunkedLicenseKey;
- LaunchFileOrURL('https://jrsoftware.org/isorder.php');
- end;
- procedure TMainForm.HRegisterClick(Sender: TObject);
- begin
- const LicenseKeyForm = TLicenseKeyForm.Create(Application);
- try
- if LicenseKeyForm.ShowModal = mrOk then begin
- WriteLicense;
- UpdateCaption;
- MsgBox('New commercial license key has been registered:' + SNewLine2 +
- GetLicenseDescription('', SNewLine2) + SNewLine2 +
- 'Thanks for your support!', SCompilerFormCaption, mbInformation, MB_OK);
- end;
- finally
- LicenseKeyForm.Free;
- end;
- end;
- procedure TMainForm.HUnregisterClick(Sender: TObject);
- begin
- if MsgBox('Are you sure you want to remove your commercial license key and revert to non-commercial use only?',
- SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then begin
- RemoveLicense;
- UpdateCaption;
- const Ini = TConfigIniFile.Create;
- try
- const AskAgainDateAsInt = FormatDateTime('yyyymmdd', IncDay(IncMonth(Date, 6), -1)).ToInteger;
- Ini.WriteInteger('UpdatePanel', 'Purchase', AskAgainDateAsInt);
- finally
- Ini.Free;
- end;
-
- MsgBox('Commercial license key has been removed.', SCompilerFormCaption, mbInformation, MB_OK);
- end;
- end;
- procedure TMainForm.HDonateClick(Sender: TObject);
- begin
- OpenDonateSite;
- end;
- procedure TMainForm.HShortcutsDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformshortcuts.htm')));
- end;
- procedure TMainForm.HRegExDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformregex.htm')));
- end;
- procedure TMainForm.HDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, 0);
- end;
- procedure TMainForm.HExamplesClick(Sender: TObject);
- begin
- LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'Examples');
- end;
- procedure TMainForm.HFaqClick(Sender: TObject);
- begin
- LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'isfaq.url');
- end;
- procedure TMainForm.HWhatsNewClick(Sender: TObject);
- begin
- LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + {$IFDEF DEBUG} '..\..\' + {$ENDIF} 'whatsnew.htm');
- end;
- procedure TMainForm.HWebsiteClick(Sender: TObject);
- begin
- LaunchFileOrURL('https://jrsoftware.org/isinfo.php');
- end;
- procedure TMainForm.HMailingListClick(Sender: TObject);
- begin
- OpenMailingListSite;
- end;
- procedure TMainForm.HISPPDocClick(Sender: TObject);
- begin
- if Assigned(HtmlHelp) then
- HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_isppoverview.htm')));
- end;
- procedure TMainForm.HAboutClick(Sender: TObject);
- var
- S: String;
- begin
- { Removing the About box or modifying any existing text inside it is a
- violation of the Inno Setup license agreement; see LICENSE.TXT.
- However, adding additional lines to the About box is permitted, as long as
- they are placed below the original copyright notice. }
- S := FCompilerVersion.Title + ' Compiler version ' +
- String(FCompilerVersion.Version) + SNewLine;
- if FCompilerVersion.Title <> 'Inno Setup' then
- S := S + (SNewLine + 'Based on Inno Setup' + SNewLine);
- S := S + ('Copyright (C) 1997-2025 Jordan Russell' + SNewLine +
- 'Portions Copyright (C) 2000-2025 Martijn Laan' + SNewLine +
- 'All rights reserved.' + SNewLine2 +
- 'Inno Setup home page:' + SNewLine +
- 'https://www.innosetup.com/' + SNewLine2 +
- 'RemObjects Pascal Script home page:' + SNewLine +
- 'https://www.remobjects.com/ps' + SNewLine2 +
- 'Refer to LICENSE.TXT for conditions of distribution and use.');
- S := S + SNewLine2 + GetLicenseDescription('Registered commercial license:' + SNewLine, SNewLine);
- MsgBox(S, 'About ' + FCompilerVersion.Title, mbInformation, MB_OK);
- end;
- procedure TMainForm.WMStartCommandLineCompile(var Message: TMessage);
- var
- Code: Integer;
- begin
- UpdateStatusPanelHeight(ClientHeight);
- Code := 0;
- try
- try
- CompileFile(CommandLineFilename, True);
- except
- Code := 2;
- Application.HandleException(Self);
- end;
- finally
- Halt(Code);
- end;
- end;
- procedure TMainForm.WMStartCommandLineWizard(var Message: TMessage);
- var
- Code: Integer;
- begin
- Code := 0;
- try
- try
- NewMainFileUsingWizard;
- except
- Code := 2;
- Application.HandleException(Self);
- end;
- finally
- Halt(Code);
- end;
- end;
- procedure TMainForm.WMStartNormally(var Message: TMessage);
- procedure ShowStartupForm;
- var
- StartupForm: TStartupForm;
- Ini: TConfigIniFile;
- begin
- ReadMRUMainFilesList;
- StartupForm := TStartupForm.Create(Application);
- try
- StartupForm.MRUFilesList := FMRUMainFilesList;
- StartupForm.StartupCheck.Checked := not FOptions.ShowStartupForm;
- if StartupForm.ShowModal = mrOK then begin
- if FOptions.ShowStartupForm <> not StartupForm.StartupCheck.Checked then begin
- FOptions.ShowStartupForm := not StartupForm.StartupCheck.Checked;
- Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
- finally
- Ini.Free;
- end;
- end;
- case StartupForm.Result of
- srEmpty:
- FNewMainFileClick(Self);
- srWizard:
- FNewMainFileUserWizardClick(Self);
- srOpenFile:
- if ConfirmCloseFile(True) then
- OpenMRUMainFile(StartupForm.ResultMainFileName);
- srOpenDialog:
- ShowOpenMainFileDialog(False);
- srOpenDialogExamples:
- ShowOpenMainFileDialog(True);
- end;
- end;
- finally
- StartupForm.Free;
- end;
- end;
- begin
- if CommandLineFilename = '' then begin
- if FOptions.ShowStartupForm then
- ShowStartupForm;
- end else
- OpenFile(FMainMemo, CommandLineFilename, False);
- end;
- procedure TMainForm.WMSysColorChange(var Message: TMessage);
- begin
- inherited;
- for var Memo in FMemos do
- Memo.SysColorChange(Message);
- end;
- procedure TMainForm.MemosTabSetPopupMenuClick(Sender: TObject);
- begin
- UpdateMemosTabSetMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.MemosTabSetClick(Sender: TObject);
- begin
- if FIgnoreTabSetClick then
- Exit;
- var NewActiveMemo := TabIndexToMemo(MemosTabSet.TabIndex, MemosTabSet.Tabs.Count-1);
- if NewActiveMemo <> FActiveMemo then begin
- { Avoiding flicker by showing new before hiding old }
- NewActiveMemo.Visible := True;
- var OldActiveMemo := FActiveMemo;
- FActiveMemo := NewActiveMemo;
- ActiveControl := NewActiveMemo;
- OldActiveMemo.CancelAutoCompleteAndCallTip;
- OldActiveMemo.Visible := False;
- UpdateSaveMenuItemAndButton;
- UpdateRunMenu;
- UpdateCaretPosPanelAndBackNavStack;
- UpdateEditModeStatusPanel;
- UpdateModifiedStatusPanel;
- end;
- end;
- procedure TMainForm.MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
- begin
- CloseTab(Index);
- end;
- procedure TMainForm.EFindClick(Sender: TObject);
- begin
- ShowFindDialog(True);
- end;
- procedure TMainForm.EFindInFilesClick(Sender: TObject);
- begin
- ShowFindInFilesDialog;
- end;
- procedure TMainForm.EFindNextOrPreviousClick(Sender: TObject);
- begin
- DoFindNext(Sender = EFindNext);
- end;
- procedure TMainForm.FindDialogFind(Sender: TObject);
- begin
- { This event handler is shared between FindDialog & ReplaceDialog }
- DoFindOrReplaceDialogFind(Sender as TFindDialog);
- end;
- procedure TMainForm.FindInFilesDialogFind(Sender: TObject);
- begin
- DoFindInFilesDialogFind;
- end;
- procedure TMainForm.EReplaceClick(Sender: TObject);
- begin
- ShowReplaceDialog;
- end;
- procedure TMainForm.ReplaceDialogReplace(Sender: TObject);
- begin
- DoReplaceDialogReplace;
- end;
- procedure TMainForm.EFindRegExClick(Sender: TObject);
- begin
- { If EFindRegEx uses Alt+R as the shortcut just like VSCode then also handle it like VSCode:
- when the memo does not have the focus open the Run menu (also Alt+R) instead }
- if not FActiveMemo.Focused and (EFindRegEx.ShortCut = ShortCut(Ord('R'), [ssAlt])) then
- SendMessage(Handle, WM_SYSCOMMAND, SC_KEYMENU, Ord('r'))
- else begin
- FOptions.FindRegEx := not FOptions.FindRegEx;
- UpdateFindRegExUI;
- var Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'FindRegEx', FOptions.FindRegEx);
- finally
- Ini.Free;
- end;
- end;
- end;
- procedure TMainForm.EFoldOrUnfoldLineClick(Sender: TObject);
- begin
- FActiveMemo.FoldLine(FActiveMemo.CaretLine, Sender = EFoldLine);
- end;
- procedure TMainForm.UpdateStatusPanelHeight(H: Integer);
- var
- MinHeight, MaxHeight: Integer;
- begin
- MinHeight := (3 * DebugOutputList.ItemHeight + ToCurrentPPI(4)) + OutputTabSet.Height;
- MaxHeight := BodyPanel.ClientHeight - ToCurrentPPI(48) - SplitPanel.Height;
- if H > MaxHeight then H := MaxHeight;
- if H < MinHeight then H := MinHeight;
- StatusPanel.Height := H;
- end;
- procedure TMainForm.UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
- procedure FindTextAndAddRanges(const AMemo: TIDEScintEdit;
- const TextToFind: TScintRawString; const Options: TScintFindOptions;
- const Selections, IndicatorRanges: TScintRangeList);
- begin
- if TScintEdit.RawStringIsBlank(TextToFind) then
- Exit;
- var StartPos := 0;
- var EndPos := AMemo.RawTextLength;
- var FoundRange: TScintRange;
- while (StartPos < EndPos) and
- AMemo.FindRawText(StartPos, EndPos, TextToFind, Options, FoundRange) do begin
- StartPos := FoundRange.EndPos;
- { Don't add indicators on lines which have a line marker }
- var Line := AMemo.GetLineFromPosition(FoundRange.StartPos);
- var Markers := AMemo.GetMarkers(Line);
- if Markers * [mlmError, mlmBreakpointBad, mlmStep] <> [] then
- Continue;
- { Add indicator while making sure it does not overlap any regular selection
- styling for either the main selection or any additional selection. Does
- not account for an indicator overlapping more than 1 selection. }
- var OverlappingSelection: TScintRange;
- if Selections.Overlaps(FoundRange, OverlappingSelection) then begin
- if FoundRange.StartPos < OverlappingSelection.StartPos then
- IndicatorRanges.Add(TScintRange.Create(FoundRange.StartPos, OverlappingSelection.StartPos));
- if FoundRange.EndPos > OverlappingSelection.EndPos then
- IndicatorRanges.Add(TScintRange.Create(OverlappingSelection.EndPos, FoundRange.EndPos));
- end else
- IndicatorRanges.Add(FoundRange);
- end;
- end;
- function HighlightAtCursorAllowed(const Word: TScintRawString): Boolean;
- begin
- const Section = FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]);
- Result := FMemosStyler.HighlightAtCursorAllowed(Section, FActiveMemo.ConvertRawStringToString(Word));
- end;
- begin
- { Add occurrence indicators for the word at cursor if there's any and the
- main selection is within this word. On top of those add occurrence indicators
- for the main selected text if there's any. Don't do anything if the main
- selection is not single line. All of these things are just like VSCode. }
- var MainSelection: TScintRange;
- var MainSelNotEmpty := AMemo.SelNotEmpty(MainSelection);
- var MainSelSingleLine := AMemo.GetLineFromPosition(MainSelection.StartPos) =
- AMemo.GetLineFromPosition(MainSelection.EndPos);
- var IndicatorRanges: TScintRangeList := nil;
- var Selections: TScintRangeList := nil;
- try
- IndicatorRanges := TScintRangeList.Create;
- Selections := TScintRangeList.Create;
- if FOptions.HighlightWordAtCursorOccurrences and (AMemo.CaretVirtualSpace = 0) and MainSelSingleLine then begin
- var Word := AMemo.WordAtCaretRange;
- if (Word.StartPos <> Word.EndPos) and MainSelection.Within(Word) then begin
- var TextToIndicate := AMemo.GetRawTextRange(Word.StartPos, Word.EndPos);
- if HighlightAtCursorAllowed(TextToIndicate) then begin
- AMemo.GetSelections(Selections); { Gets any additional selections as well }
- FindTextAndAddRanges(AMemo, TextToIndicate, [sfoMatchCase, sfoWholeWord], Selections, IndicatorRanges);
- end;
- end;
- end;
- AMemo.UpdateIndicators(IndicatorRanges, minWordAtCursorOccurrence);
- IndicatorRanges.Clear;
- if FOptions.HighlightSelTextOccurrences and MainSelNotEmpty and MainSelSingleLine then begin
- var TextToIndicate := AMemo.RawMainSelText;
- if Selections.Count = 0 then { If 0 then we didn't already call GetSelections above}
- AMemo.GetSelections(Selections);
- FindTextAndAddRanges(AMemo, TextToIndicate, [], Selections, IndicatorRanges);
- end;
- AMemo.UpdateIndicators(IndicatorRanges, minSelTextOccurrence);
- finally
- Selections.Free;
- IndicatorRanges.Free;
- end;
- end;
- procedure TMainForm.UpdateImages;
- { Should be called at startup and after DPI changes }
- begin
- var WH := MulDiv(16, CurrentPPI, 96);
- var Images := ImagesModule.ToolbarImageCollection[FTheme.Dark];
- var Image := Images.GetSourceImage(Images.GetIndexByName('heart-filled'), WH, WH);
- UpdatePanelDonateBitBtn.Graphic := Image;
- end;
- procedure TMainForm.UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
- { Should be called at startup and after DPI changes }
- begin
- CompilerOutputList.Canvas.Font.Assign(CompilerOutputList.Font);
- CompilerOutputList.ItemHeight := CompilerOutputList.Canvas.TextHeight('0') + 1;
- DebugOutputList.Canvas.Font.Assign(DebugOutputList.Font);
- FDebugLogListTimestampsWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000] ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator]));
- DebugOutputList.ItemHeight := DebugOutputList.Canvas.TextHeight('0') + 1;
- DebugCallStackList.Canvas.Font.Assign(DebugCallStackList.Font);
- DebugCallStackList.ItemHeight := DebugCallStackList.Canvas.TextHeight('0') + 1;
- FindResultsList.Canvas.Font.Assign(FindResultsList.Font);
- FindResultsList.ItemHeight := FindResultsList.Canvas.TextHeight('0') + 1;
- end;
- type
- TBitmapWithBits = class
- Handle: HBITMAP;
- pvBits: Pointer;
- destructor Destroy; override;
- end;
- destructor TBitmapWithBits.Destroy;
- begin
- if Handle <> 0 then
- DeleteObject(Handle);
- inherited;
- end;
- procedure TMainForm.UpdateMarginsAndAutoCompleteIcons;
- { Should be called at startup and after theme and DPI changes }
- type
- TMarkerOrACBitmaps = TObjectDictionary<Integer, TBitmapWithBits>;
- procedure SwapRedBlue(const pvBits: PByte; Width, Height: Integer);
- begin
- var pvPixel := pvBits;
- var pvMax := pvBits + 4*Width*Height;
- while pvPixel < pvMax do begin
- var Tmp := PByte(pvPixel)^;
- PByte(pvPixel)^ := PByte(pvPixel + 2)^;
- PByte(pvPixel + 2)^ := Tmp;
- Inc(pvPixel, 4);
- end;
- end;
- procedure AddMarkerOrACBitmap(const MarkerOrACBitmaps: TMarkerOrACBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
- const MarkerNumberOrACType: Integer; const BkBrush: TBrush; const ImageList: TVirtualImageList; const ImageName: String);
- begin
- { Prepare a bitmap and select it }
- var pvBits: Pointer;
- var Bitmap := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0);
- var OldBitmap := SelectObject(DC, Bitmap);
- { Fill the entire bitmap to avoid any alpha so we don't have to worry about
- whether will be premultiplied or not (it was in tests) when Scintilla wants
- it without premultiplication }
- var Width := BitmapInfo.bmiHeader.biWidth;
- var Height := Abs(BitmapInfo.bmiHeader.biHeight);
- var Rect := TRect.Create(0, 0, Width, Height);
- FillRect(DC, Rect, BkBrush.Handle);
- { Draw the image - the result will be in pvBits }
- if ImageList_Draw(ImageList.Handle, ImageList.GetIndexByName(ImageName), DC, 0, 0, ILD_TRANSPARENT) then begin
- SwapRedBlue(pvBits, Width, Height); { Change pvBits from BGRA to RGBA like Scintilla wants }
- var Bitmap2 := TBitmapWithBits.Create;
- Bitmap2.Handle := Bitmap;
- Bitmap2.pvBits := pvBits;
- MarkerOrACBitmaps.Add(MarkerNumberOrACType, Bitmap2);
- end else begin
- SelectObject(DC, OldBitmap);
- DeleteObject(Bitmap);
- end;
- end;
- type
- TMarkerNumberOrACType = TPair<Integer, String>;
- function NNT(const MarkerNumberOrACType: Integer; const Name: String): TMarkerNumberOrACType;
- begin
- Result := TMarkerNumberOrACType.Create(MarkerNumberOrACType, Name); { This is a record so no need to free }
- end;
- begin
- var ImageList := ThemedMarkersAndACVirtualImageList;
- var DC := CreateCompatibleDC(0);
- if DC <> 0 then begin
- try
- var MarkerBitmaps: TMarkerOrACBitmaps := nil;
- var MarkerBkBrush: TBrush := nil;
- var AutoCompleteBitmaps: TMarkerOrACBitmaps := nil;
- var AutoCompleteBkBrush: TBrush := nil;
- try
- var BitmapInfo := CreateBitmapInfo(ImageList.Width, -ImageList.Height, 32); { This is a record so no need to free }
- MarkerBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
- MarkerBkBrush := TBrush.Create;
- MarkerBkBrush.Color := FTheme.Colors[tcMarginBack];
- var NamedMarkers := [
- NNT(mmiHasEntry, 'markers\debug-stop-filled'),
- NNT(mmiEntryProcessed, 'markers\debug-stop-filled_2'),
- NNT(mmiBreakpoint, 'markers\debug-breakpoint-filled'),
- NNT(mmiBreakpointBad, 'markers\debug-breakpoint-filled-cancel-2'),
- NNT(mmiBreakpointGood, 'markers\debug-breakpoint-filled-ok-2'),
- NNT(mmiStep, 'markers\symbol-arrow-right'),
- NNT(mmiBreakpointStep, 'markers\debug-breakpoint-filled-ok2-symbol-arrow-right'),
- NNT(SC_MARKNUM_FOLDER, 'markers\symbol-add'),
- NNT(SC_MARKNUM_FOLDEROPEN, 'markers\symbol-remove')];
- for var NamedMarker in NamedMarkers do
- AddMarkerOrAcBitmap(MarkerBitmaps, DC, BitmapInfo, NamedMarker.Key, MarkerBkBrush, ImageList, NamedMarker.Value);
- AutoCompleteBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
- AutoCompleteBkBrush := TBrush.Create;
- AutoCompleteBkBrush.Color := FTheme.Colors[tcIntelliBack];
- var NamedTypes := [
- NNT(awtSection, 'ac\structure-filled'),
- NNT(awtParameter, 'ac\xml-filled'),
- NNT(awtDirective, 'ac\xml-filled'),
- NNT(awtFlagOrSetupDirectiveValue, 'ac\values'),
- NNT(awtPreprocessorDirective, 'ac\symbol-hashtag'),
- NNT(awtConstant, 'ac\constant-filled_2'),
- NNT(awtScriptFunction, 'ac\method-filled'),
- NNT(awtScriptType, 'ac\types'),
- NNT(awtScriptVariable, 'ac\variables'),
- NNT(awtScriptConstant, 'ac\constant-filled'),
- NNT(awtScriptInterface, 'ac\interface-filled'),
- NNT(awtScriptProperty, 'ac\properties-filled'),
- NNT(awtScriptEvent, 'ac\event-filled'),
- NNT(awtScriptKeyword, 'ac\list'),
- NNT(awtScriptEnumValue, 'ac\constant-filled')];
- for var NamedType in NamedTypes do
- AddMarkerOrAcBitmap(AutoCompleteBitmaps, DC, BitmapInfo, NamedType.Key, AutoCompleteBkBrush, ImageList, NamedType.Value);
- for var Memo in FMemos do begin
- Memo.Call(SCI_RGBAIMAGESETWIDTH, ImageList.Width, 0);
- Memo.Call(SCI_RGBAIMAGESETHEIGHT, ImageList.Height, 0);
- for var MarkerBitmap in MarkerBitmaps do
- Memo.Call(SCI_MARKERDEFINERGBAIMAGE, MarkerBitmap.Key, LPARAM(MarkerBitmap.Value.pvBits));
- for var AutoCompleteBitmap in AutoCompleteBitmaps do
- Memo.Call(SCI_REGISTERRGBAIMAGE, AutoCompleteBitmap.Key, LPARAM(AutoCompleteBitmap.Value.pvBits));
- end;
- finally
- AutoCompleteBkBrush.Free;
- AutoCompleteBitmaps.Free;
- MarkerBkBrush.Free;
- MarkerBitmaps.Free;
- end;
- finally
- DeleteDC(DC);
- end;
- end;
- end;
- procedure TMainForm.UpdateMarginsAndSquigglyAndCaretWidths;
- { Update the width of our two margins. Note: the width of the line numbers
- margin is fully handled by TScintEdit. Should be called at startup and after
- DPI change. }
- begin
- var IconMarkersWidth := ToCurrentPPI(18); { 3 pixel margin on both sides of the icon }
- 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" }
- var FolderMarkersWidth := ToCurrentPPI(14); { 1 pixel margin on boths side of the icon }
- var LeftBlankMarginWidth := ToCurrentPPI(2); { 2 pixel margin between gutter and the main text }
- var SquigglyWidth := ToCurrentPPI(100); { 100 = 1 pixel }
- var CaretWidth := ToCurrentPPI(2);
- var WhiteSpaceSize := CaretWidth;
- for var Memo in FMemos do
- Memo.UpdateWidthsAndSizes(IconMarkersWidth, BaseChangeHistoryWidth, FolderMarkersWidth,
- LeftBlankMarginWidth, 0, SquigglyWidth, CaretWidth, WhiteSpaceSize);
- end;
- procedure TMainForm.SplitPanelMouseMove(Sender: TObject;
- Shift: TShiftState; X, Y: Integer);
- begin
- if (ssLeft in Shift) and StatusPanel.Visible then begin
- UpdateStatusPanelHeight(BodyPanel.ClientToScreen(Point(0, 0)).Y -
- SplitPanel.ClientToScreen(Point(0, Y)).Y +
- BodyPanel.ClientHeight - (SplitPanel.Height div 2));
- end;
- end;
- procedure TMainForm.SimpleMenuClick(Sender: TObject);
- begin
- UpdateSimpleMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.TMenuClick(Sender: TObject);
- begin
- UpdateToolsMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.TAddRemoveProgramsClick(Sender: TObject);
- begin
- StartAddRemovePrograms;
- end;
- procedure TMainForm.TGenerateGUIDClick(Sender: TObject);
- begin
- InsertGeneratedGuid(FActiveMemo);
- end;
- procedure TMainForm.TMsgBoxDesignerClick(Sender: TObject);
- begin
- ShowMsgBoxDesignerForm(FActiveMemo);
- end;
- procedure TMainForm.TRegistryDesignerClick(Sender: TObject);
- begin
- ShowRegistryDesignerForm(FActiveMemo);
- end;
- procedure TMainForm.TFilesDesignerClick(Sender: TObject);
- begin
- ShowFilesDesignerForm(FActiveMemo);
- end;
- procedure TMainForm.TSignToolsClick(Sender: TObject);
- begin
- ShowSignToolsForm;
- end;
- procedure TMainForm.TOptionsClick(Sender: TObject);
- var
- OptionsForm: TOptionsForm;
- Ini: TConfigIniFile;
- Memo: TIDEScintEdit;
- begin
- OptionsForm := TOptionsForm.Create(Application);
- try
- OptionsForm.StartupCheck.Checked := FOptions.ShowStartupForm;
- OptionsForm.WizardCheck.Checked := FOptions.UseWizard;
- OptionsForm.AutosaveCheck.Checked := FOptions.Autosave;
- OptionsForm.AutoreloadCheck.Checked := FOptions.Autoreload;
- OptionsForm.BackupCheck.Checked := FOptions.MakeBackups;
- OptionsForm.FullPathCheck.Checked := FOptions.FullPathInTitleBar;
- OptionsForm.UndoAfterSaveCheck.Checked := FOptions.UndoAfterSave;
- OptionsForm.UndoAfterReloadCheck.Checked := FOptions.UndoAfterReload;
- OptionsForm.PauseOnDebuggerExceptionsCheck.Checked := FOptions.PauseOnDebuggerExceptions;
- OptionsForm.RunAsDifferentUserCheck.Checked := FOptions.RunAsDifferentUser;
- OptionsForm.AutoAutoCompleteCheck.Checked := FOptions.AutoAutoComplete;
- OptionsForm.UseSynHighCheck.Checked := FOptions.UseSyntaxHighlighting;
- OptionsForm.ColorizeCompilerOutputCheck.Checked := FOptions.ColorizeCompilerOutput;
- OptionsForm.UnderlineErrorsCheck.Checked := FOptions.UnderlineErrors;
- OptionsForm.CursorPastEOLCheck.Checked := FOptions.CursorPastEOL;
- OptionsForm.TabWidthEdit.Text := IntToStr(FOptions.TabWidth);
- OptionsForm.UseTabCharacterCheck.Checked := FOptions.UseTabCharacter;
- OptionsForm.ShowWhiteSpaceCheck.Checked := FOptions.ShowWhiteSpace;
- OptionsForm.UseFoldingCheck.Checked := FOptions.UseFolding;
- OptionsForm.AutoIndentCheck.Checked := FOptions.AutoIndent;
- OptionsForm.IndentationGuidesCheck.Checked := FOptions.IndentationGuides;
- OptionsForm.GutterLineNumbersCheck.Checked := FOptions.GutterLineNumbers;
- OptionsForm.ShowPreprocessorOutputCheck.Checked := FOptions.ShowPreprocessorOutput;
- OptionsForm.OpenIncludedFilesCheck.Checked := FOptions.OpenIncludedFiles;
- OptionsForm.AutoHideNewIncludedFilesCheck.Checked := FOptions.AutoHideNewIncludedFiles;
- OptionsForm.KeyMappingComboBox.ItemIndex := Ord(FOptions.KeyMappingType);
- OptionsForm.MemoKeyMappingComboBox.ItemIndex := Ord(FOptions.MemoKeyMappingType);
- OptionsForm.ThemeComboBox.ItemIndex := Ord(FOptions.ThemeType);
- OptionsForm.FontPanel.Font.Assign(FMainMemo.Font);
- OptionsForm.FontPanel.ParentBackground := False;
- OptionsForm.FontPanel.Color := FMainMemo.Color;
- OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked := FOptions.HighlightWordAtCursorOccurrences;
- OptionsForm.HighlightSelTextOccurrencesCheck.Checked := FOptions.HighlightSelTextOccurrences;
- if OptionsForm.ShowModal <> mrOK then
- Exit;
- FOptions.ShowStartupForm := OptionsForm.StartupCheck.Checked;
- FOptions.UseWizard := OptionsForm.WizardCheck.Checked;
- FOptions.Autosave := OptionsForm.AutosaveCheck.Checked;
- FOptions.Autoreload := OptionsForm.AutoreloadCheck.Checked;
- FOptions.MakeBackups := OptionsForm.BackupCheck.Checked;
- FOptions.FullPathInTitleBar := OptionsForm.FullPathCheck.Checked;
- FOptions.UndoAfterSave := OptionsForm.UndoAfterSaveCheck.Checked;
- FOptions.UndoAfterReload := OptionsForm.UndoAfterReloadCheck.Checked;
- FOptions.PauseOnDebuggerExceptions := OptionsForm.PauseOnDebuggerExceptionsCheck.Checked;
- FOptions.RunAsDifferentUser := OptionsForm.RunAsDifferentUserCheck.Checked;
- FOptions.AutoAutoComplete := OptionsForm.AutoAutoCompleteCheck.Checked;
- FOptions.UseSyntaxHighlighting := OptionsForm.UseSynHighCheck.Checked;
- FOptions.ColorizeCompilerOutput := OptionsForm.ColorizeCompilerOutputCheck.Checked;
- FOptions.UnderlineErrors := OptionsForm.UnderlineErrorsCheck.Checked;
- FOptions.CursorPastEOL := OptionsForm.CursorPastEOLCheck.Checked;
- FOptions.TabWidth := StrToInt(OptionsForm.TabWidthEdit.Text);
- FOptions.UseTabCharacter := OptionsForm.UseTabCharacterCheck.Checked;
- FOptions.ShowWhiteSpace := OptionsForm.ShowWhiteSpaceCheck.Checked;
- FOptions.UseFolding := OptionsForm.UseFoldingCheck.Checked;
- FOptions.AutoIndent := OptionsForm.AutoIndentCheck.Checked;
- FOptions.IndentationGuides := OptionsForm.IndentationGuidesCheck.Checked;
- FOptions.GutterLineNumbers := OptionsForm.GutterLineNumbersCheck.Checked;
- FOptions.ShowPreprocessorOutput := OptionsForm.ShowPreprocessorOutputCheck.Checked;
- FOptions.OpenIncludedFiles := OptionsForm.OpenIncludedFilesCheck.Checked;
- FOptions.AutoHideNewIncludedFiles := OptionsForm.AutoHideNewIncludedFilesCheck.Checked;
- FOptions.KeyMappingType := TKeyMappingType(OptionsForm.KeyMappingComboBox.ItemIndex);
- FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(OptionsForm.MemoKeyMappingComboBox.ItemIndex);
- FOptions.ThemeType := TThemeType(OptionsForm.ThemeComboBox.ItemIndex);
- FOptions.HighlightWordAtCursorOccurrences := OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked;
- FOptions.HighlightSelTextOccurrences := OptionsForm.HighlightSelTextOccurrencesCheck.Checked;
- UpdateCaption;
- UpdatePreprocMemos;
- InvalidateStatusPanel(spHiddenFilesCount);
- for Memo in FMemos do begin
- { Move caret to start of line to ensure it doesn't end up in the middle
- of a double-byte character if the code page changes from SBCS to DBCS }
- Memo.CaretLine := Memo.CaretLine;
- Memo.Font.Assign(OptionsForm.FontPanel.Font);
- end;
- SyncEditorOptions;
- UpdateMarginsAndSquigglyAndCaretWidths;
- UpdateNewMainFileButtons;
- UpdateOccurrenceIndicators(FActiveMemo);
- UpdateKeyMapping;
- UpdateTheme;
- { Save new options }
- Ini := TConfigIniFile.Create;
- try
- Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
- Ini.WriteBool('Options', 'UseWizard', FOptions.UseWizard);
- Ini.WriteBool('Options', 'Autosave', FOptions.Autosave);
- Ini.WriteBool('Options', 'Autoreload', FOptions.Autoreload);
- Ini.WriteBool('Options', 'MakeBackups', FOptions.MakeBackups);
- Ini.WriteBool('Options', 'FullPathInTitleBar', FOptions.FullPathInTitleBar);
- Ini.WriteBool('Options', 'UndoAfterSave', FOptions.UndoAfterSave);
- Ini.WriteBool('Options', 'UndoAfterReload', FOptions.UndoAfterReload);
- Ini.WriteBool('Options', 'PauseOnDebuggerExceptions', FOptions.PauseOnDebuggerExceptions);
- Ini.WriteBool('Options', 'RunAsDifferentUser', FOptions.RunAsDifferentUser);
- Ini.WriteBool('Options', 'AutoComplete', FOptions.AutoAutoComplete);
- Ini.WriteBool('Options', 'AutoCallTips', FOptions.AutoCallTips);
- Ini.WriteBool('Options', 'UseSynHigh', FOptions.UseSyntaxHighlighting);
- Ini.WriteBool('Options', 'ColorizeCompilerOutput', FOptions.ColorizeCompilerOutput);
- Ini.WriteBool('Options', 'UnderlineErrors', FOptions.UnderlineErrors);
- Ini.WriteBool('Options', 'HighlightWordAtCursorOccurrences', FOptions.HighlightWordAtCursorOccurrences);
- Ini.WriteBool('Options', 'HighlightSelTextOccurrences', FOptions.HighlightSelTextOccurrences);
- Ini.WriteBool('Options', 'EditorCursorPastEOL', FOptions.CursorPastEOL);
- Ini.WriteInteger('Options', 'TabWidth', FOptions.TabWidth);
- Ini.WriteBool('Options', 'UseTabCharacter', FOptions.UseTabCharacter);
- Ini.WriteBool('Options', 'ShowWhiteSpace', FOptions.ShowWhiteSpace);
- Ini.WriteBool('Options', 'UseFolding', FOptions.UseFolding);
- Ini.WriteBool('Options', 'AutoIndent', FOptions.AutoIndent);
- Ini.WriteBool('Options', 'IndentationGuides', FOptions.IndentationGuides);
- Ini.WriteBool('Options', 'GutterLineNumbers', FOptions.GutterLineNumbers);
- Ini.WriteBool('Options', 'ShowPreprocessorOutput', FOptions.ShowPreprocessorOutput);
- Ini.WriteBool('Options', 'OpenIncludedFiles', FOptions.OpenIncludedFiles);
- Ini.WriteBool('Options', 'AutoHideNewIncludedFiles', FOptions.AutoHideNewIncludedFiles);
- Ini.WriteInteger('Options', 'KeyMappingType', Ord(FOptions.KeyMappingType));
- Ini.WriteInteger('Options', 'MemoKeyMappingType', Ord(FOptions.MemoKeyMappingType));
- Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see Destroy }
- Ini.WriteString('Options', 'EditorFontName', FMainMemo.Font.Name);
- Ini.WriteInteger('Options', 'EditorFontSize', FMainMemo.Font.Size);
- Ini.WriteInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
- finally
- Ini.Free;
- end;
- finally
- OptionsForm.Free;
- end;
- end;
- { Also see TabIndexToMemoIndex }
- function TMainForm.MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
- begin
- if AMemo = FMainMemo then
- Result := 0 { First tab displays the main memo }
- else if AMemo = FPreprocessorOutputMemo then begin
- if not FPreprocessorOutputMemo.Used then
- raise Exception.Create('not FPreprocessorOutputMemo.Used');
- Result := MemosTabSet.Tabs.Count-1 { Last tab displays the preprocessor output memo }
- end else begin
- Result := FFileMemos.IndexOf(AMemo as TIDEScintFileEdit); { Other tabs display include files which start second tab }
- { Filter memos explicitly hidden by the user }
- for var MemoIndex := Result-1 downto 0 do
- if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) <> -1 then
- Dec(Result);
- end;
- end;
- { Also see MemoToTabIndex }
- function TMainForm.TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
- begin
- if ATabIndex = 0 then
- Result := FMemos[0] { First tab displays the main memo which is FMemos[0] }
- else if FPreprocessorOutputMemo.Used and (ATabIndex = AMaxTabIndex) then
- Result := FMemos[1] { Last tab displays the preprocessor output memo which is FMemos[1] }
- else begin
- { Only count memos not explicitly hidden by the user }
- var TabIndex := 0;
- for var MemoIndex := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
- if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) = -1 then begin
- Inc(TabIndex);
- if TabIndex = ATabIndex then begin
- Result := FMemos[MemoIndex + 1]; { Other tabs display include files which start at second tab but at FMemos[2] }
- Exit;
- end;
- end;
- end;
- raise Exception.Create('TabIndexToMemo failed');
- end;
- end;
- procedure TMainForm.MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
- const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean; const IsPosition: Boolean;
- const PositionVirtualSpace: Integer);
- var
- Pos: Integer;
- begin
- { Reopen tab if needed }
- if AMemo is TIDEScintFileEdit then begin
- var FileName := (AMemo as TIDEScintFileEdit).Filename;
- var HiddenFileIndex := FHiddenFiles.IndexOf(Filename);
- if HiddenFileIndex <> -1 then begin
- ReopenTabOrTabs(HiddenFileIndex, False);
- { The above call to ReopenTabOrTabs will currently lead to a call to UpdateIncludedFilesMemos which
- sets up all the memos. Currently it will keep same memo for the reopened file but in case it no
- longer does at some point: look it up again }
- AMemo := nil;
- for var Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, Filename) = 0) then begin
- AMemo := Memo;
- Break;
- end;
- end;
- if AMemo = nil then
- raise Exception.Create('AMemo MIA');
- end;
- end;
- { Move caret }
- if IsPosition then
- Pos := LineNumberOrPosition
- else if AlwaysResetColumnEvenIfOnRequestedLineAlready or (AMemo.CaretLine <> LineNumberOrPosition) then
- Pos := AMemo.GetPositionFromLine(LineNumberOrPosition)
- else
- Pos := AMemo.CaretPosition; { Not actually moving caret - it's already were we want it}
- { If the line is in a contracted section, expand it }
- AMemo.EnsureLineVisible(AMemo.GetLineFromPosition(Pos));
- { If the line isn't in view, scroll so that it's in the center }
- if not AMemo.IsPositionInViewVertically(Pos) then
- AMemo.TopLine := AMemo.GetVisibleLineFromDocLine(AMemo.GetLineFromPosition(Pos)) -
- (AMemo.LinesInWindow div 2);
- AMemo.CaretPosition := Pos;
- if IsPosition then
- AMemo.CaretVirtualSpace := PositionVirtualSpace;
- { Activate memo }
- MemosTabSet.TabIndex := MemoToTabIndex(AMemo); { This causes MemosTabSetClick to show the memo }
- end;
- procedure TMainForm.SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
- var
- OldLine: Integer;
- begin
- if AMemo <> FErrorMemo then begin
- SetErrorLine(FErrorMemo, -1);
- FErrorMemo := AMemo;
- end;
- if FErrorMemo.ErrorLine <> ALine then begin
- OldLine := FErrorMemo.ErrorLine;
- FErrorMemo.ErrorLine := ALine;
- if OldLine >= 0 then
- UpdateLineMarkers(FErrorMemo, OldLine);
- if FErrorMemo.ErrorLine >= 0 then begin
- FErrorMemo.ErrorCaretPosition := FErrorMemo.CaretPosition;
- UpdateLineMarkers(FErrorMemo, FErrorMemo.ErrorLine);
- end;
- end;
- end;
- procedure TMainForm.SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
- var
- OldLine: Integer;
- begin
- if AMemo <> FStepMemo then begin
- SetStepLine(FStepMemo, -1);
- FStepMemo := AMemo;
- end;
- if FStepMemo.StepLine <> ALine then begin
- OldLine := FStepMemo.StepLine;
- FStepMemo.StepLine := ALine;
- if OldLine >= 0 then
- UpdateLineMarkers(FStepMemo, OldLine);
- if FStepMemo.StepLine >= 0 then
- UpdateLineMarkers(FStepMemo, FStepMemo.StepLine);
- end;
- end;
- procedure TMainForm.HideError;
- begin
- SetErrorLine(FErrorMemo, -1);
- if not FCompiling then
- StatusBar.Panels[spExtraStatus].Text := '';
- end;
- procedure TMainForm.BackNavButtonClick(Sender: TObject);
- begin
- NavigateBack;
- end;
- procedure TMainForm.ForwardNavButtonClick(Sender: TObject);
- begin
- NavigateForward;
- end;
- procedure TMainForm.WMAppCommand(var Message: TMessage);
- begin
- HandleNavigationAppCommand(Message);
- end;
- procedure TMainForm.NavPopupMenuClick(Sender: TObject);
- begin
- UpdateNavigationMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.UpdateCaretPosPanelAndBackNavStack;
- begin
- { Update panel }
- var Text := Format('%4d:%4d', [FActiveMemo.CaretLine + 1,
- FActiveMemo.CaretColumnExpandedForTabs + 1]);
- if FOptions.ShowCaretPosition then begin
- const CaretPos = FActiveMemo.CaretPosition;
- const Style = FActiveMemo.GetStyleAtPosition(CaretPos);
- Text := Format('%s@%d+%d:%s', [Copy(GetEnumName(TypeInfo(TInnoSetupStylerStyle), Style), 3, MaxInt),
- CaretPos, FActiveMemo.CaretVirtualSpace, Text]);
- end;
- StatusBar.Panels[spCaretPos].Text := Text;
- UpdateBackNavigationStack;
- end;
- procedure TMainForm.UpdateEditModeStatusPanel;
- const
- InsertText: array[Boolean] of String = ('Overwrite', 'Insert');
- begin
- if FActiveMemo.ReadOnly then
- StatusBar.Panels[spEditMode].Text := 'Read only'
- else
- StatusBar.Panels[spEditMode].Text := InsertText[FActiveMemo.InsertMode];
- end;
- procedure TMainForm.UpdateFindRegExUI;
- const
- FindRegExText: array[Boolean] of String = ('', '.*');
- begin
- StatusBar.Panels[spFindRegEx].Text := FindRegExText[FOptions.FindRegEx];
- if FOptions.FindRegEx then begin
- FindDialog.Options := FindDialog.Options + [frHideWholeWord];
- ReplaceDialog.Options := ReplaceDialog.Options + [frHideWholeWord];
- end else begin
- FindDialog.Options := FindDialog.Options - [frHideWholeWord];
- ReplaceDialog.Options := ReplaceDialog.Options - [frHideWholeWord];
- end;
- end;
- procedure TMainForm.UpdateMemosTabSetVisibility;
- begin
- MemosTabSet.Visible := FPreprocessorOutputMemo.Used or FFileMemos[FirstIncludedFilesMemoIndex].Used;
- if not MemosTabSet.Visible then
- MemosTabSet.TabIndex := 0; { For next time }
- end;
- procedure TMainForm.UpdateModifiedStatusPanel;
- begin
- if FActiveMemo.Modified then
- StatusBar.Panels[spModified].Text := 'Modified'
- else
- StatusBar.Panels[spModified].Text := '';
- end;
- { Set DontUpdateRelatedVisibilty if you're going to call this function again, avoids flicker }
- procedure TMainForm.UpdatePreprocMemos(const DontUpdateRelatedVisibilty: Boolean);
- procedure UpdatePreprocessorOutputMemo(const NewTabs, NewHints: TStringList;
- const NewCloseButtons: TBoolList);
- begin
- if FOptions.ShowPreprocessorOutput and (FPreprocessorOutput <> '') and
- (FMainMemo.Lines.Text.TrimRight <> FPreprocessorOutput) then begin
- NewTabs.Add('Preprocessor Output');
- NewHints.Add('');
- NewCloseButtons.Add(False);
- FPreprocessorOutputMemo.ReadOnly := False;
- try
- FPreprocessorOutputMemo.Lines.Text := FPreprocessorOutput;
- FPreprocessorOutputMemo.ClearUndo;
- finally
- FPreprocessorOutputMemo.ReadOnly := True;
- end;
- FPreprocessorOutputMemo.Used := True;
- end else begin
- if FPreprocessorOutputMemo.Used then
- RemoveMemoFromNavigation(FPreprocessorOutputMemo);
- FPreprocessorOutputMemo.Used := False;
- FPreprocessorOutputMemo.Visible := False;
- end;
- end;
- procedure UpdateIncludedFilesMemos(const NewTabs, NewHints: TStringList;
- const NewCloseButtons: TBoolList);
- var
- IncludedFile: TIncludedFile;
- I: Integer;
- begin
- if FOptions.OpenIncludedFiles and (FIncludedFiles.Count > 0) then begin
- var NextMemoIndex := FirstIncludedFilesMemoIndex;
- var NextTabIndex := 1; { First tab displays the main memo }
- for IncludedFile in FIncludedFiles do begin
- IncludedFile.Memo := FFileMemos[NextMemoIndex];
- try
- if not IncludedFile.Memo.Used or
- ((PathCompare(IncludedFile.Memo.Filename, IncludedFile.Filename) <> 0) or
- not IncludedFile.HasLastWriteTime or
- (CompareFileTime(IncludedFile.Memo.FileLastWriteTime, IncludedFile.LastWriteTime) <> 0)) then begin
- IncludedFile.Memo.Filename := IncludedFile.Filename;
- IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
- OpenFile(IncludedFile.Memo, IncludedFile.Filename, False); { Also updates FileLastWriteTime }
- IncludedFile.Memo.Used := True;
- end else begin
- { The memo assigned to the included file already has that file loaded
- and is up-to-date so no call to OpenFile is needed. However, it could be
- that CompilerFileIndex is not set yet. This happens if the initial
- load was from the history loaded by LoadKnownIncludedAndHiddenFiles
- and is followed by the user doing a compile. }
- if IncludedFile.Memo.CompilerFileIndex = UnknownCompilerFileIndex then
- IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
- end;
- if FHiddenFiles.IndexOf(IncludedFile.Filename) = -1 then begin
- NewTabs.Insert(NextTabIndex, GetDisplayFilename(IncludedFile.Filename));
- NewHints.Insert(NextTabIndex, GetFileTitle(IncludedFile.Filename));
- NewCloseButtons.Insert(NextTabIndex, True);
- Inc(NextTabIndex);
- end;
- Inc(NextMemoIndex);
- if NextMemoIndex = FFileMemos.Count then
- Break; { We're out of memos :( }
- except on E: Exception do
- begin
- StatusMessage(smkWarning, 'Failed to open included file: ' + E.Message);
- IncludedFile.Memo := nil;
- end;
- end;
- end;
- { Hide any remaining memos }
- for I := NextMemoIndex to FFileMemos.Count-1 do begin
- FFileMemos[I].BreakPoints.Clear;
- if FFileMemos[I].Used then
- RemoveMemoFromNavigation(FFileMemos[I]);
- FFileMemos[I].Used := False;
- FFileMemos[I].Visible := False;
- end;
- end else begin
- for I := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
- FFileMemos[I].BreakPoints.Clear;
- if FFileMemos[I].Used then
- RemoveMemoFromNavigation(FFileMemos[I]);
- FFileMemos[I].Used := False;
- FFileMemos[I].Visible := False;
- end;
- for IncludedFile in FIncludedFiles do
- IncludedFile.Memo := nil;
- end;
- end;
- var
- NewTabs, NewHints: TStringList;
- NewCloseButtons: TBoolList;
- I, SaveTabIndex: Integer;
- SaveTabName: String;
- begin
- NewTabs := nil;
- NewHints := nil;
- NewCloseButtons := nil;
- try
- NewTabs := TStringList.Create;
- NewTabs.Add(MemosTabSet.Tabs[0]); { 'Main Script' }
- NewHints := TStringList.Create;
- NewHints.Add(GetFileTitle(FMainMemo.Filename));
- NewCloseButtons := TBoolList.Create;
- NewCloseButtons.Add(False);
- UpdatePreprocessorOutputMemo(NewTabs, NewHints, NewCloseButtons);
- UpdateIncludedFilesMemos(NewTabs, NewHints, NewCloseButtons);
- { Set new tabs, try keep same file open }
- SaveTabIndex := MemosTabSet.TabIndex;
- SaveTabName := MemosTabSet.Tabs[MemosTabSet.TabIndex];
- MemosTabSet.Tabs := NewTabs;
- MemosTabSet.Hints := NewHints;
- MemosTabSet.CloseButtons := NewCloseButtons;
- I := MemosTabSet.Tabs.IndexOf(SaveTabName);
- if I <> -1 then
- MemosTabSet.TabIndex := I;
- if MemosTabSet.TabIndex = SaveTabIndex then begin
- { If TabIndex stayed the same then the tabset won't perform a Click but we need this to make
- sure the right memo is visible - so trigger it ourselves }
- MemosTabSetClick(MemosTabSet);
- end;
- finally
- NewCloseButtons.Free;
- NewHints.Free;
- NewTabs.Free;
- end;
- if not DontUpdateRelatedVisibilty then begin
- UpdateMemosTabSetVisibility;
- UpdateBevel1Visibility;
- end;
- end;
- procedure TMainForm.MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
- procedure UpdatePendingSquiggly(const AMemo: TIDEScintEdit);
- var
- Pos: Integer;
- Value: Boolean;
- begin
- { Check for the inPendingSquiggly indicator on either side of the caret }
- Pos := AMemo.CaretPosition;
- Value := False;
- if AMemo.CaretVirtualSpace = 0 then begin
- Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos);
- if not Value and (Pos > 0) then
- Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos-1);
- end;
- if FOnPendingSquiggly <> Value then begin
- FOnPendingSquiggly := Value;
- { If caret has left a pending squiggly, force restyle of the line }
- if not Value then begin
- { Stop reporting the caret position to the styler (until the next
- Change event) so the token doesn't re-enter pending-squiggly state
- if the caret comes back and something restyles the line }
- AMemo.ReportCaretPositionToStyler := False;
- AMemo.RestyleLine(AMemo.GetLineFromPosition(FPendingSquigglyCaretPos));
- end;
- end;
- FPendingSquigglyCaretPos := Pos;
- end;
- procedure UpdateBraceHighlighting(const AMemo: TIDEScintEdit);
- const
- OpeningBraces: TSysCharSet = ['(', '[', '{', '<'];
- ClosingBraces: TSysCharSet = [')', ']', '}', '>'];
- function HighlightPos(const AMemo: TIDEScintEdit; const CaretPos: Integer;
- const Before: Boolean; const Braces: TSysCharSet): Boolean;
- begin
- var Pos := CaretPos;
- if Before then begin
- if Pos > 0 then
- Pos := AMemo.GetPositionBefore(Pos)
- else
- Exit(False);
- end;
- var C := AMemo.GetByteAtPosition(Pos);
- Result := C in Braces;
- if Result then begin
- var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos);
- if MatchPos >= 0 then
- AMemo.SetBraceHighlighting(Pos, MatchPos)
- else begin
- { Found an unmatched brace: highlight it as bad unless it's an opening
- brace and the caret is at the end of the line }
- var CaretLineEndPos := AMemo.GetLineEndPosition(AMemo.CaretLine);
- if (C in ClosingBraces) or (CaretPos <> CaretLineEndPos) then
- AMemo.SetBraceBadHighlighting(Pos)
- else
- AMemo.SetBraceHighlighting(-1, -1);
- end;
- end;
- end;
- begin
- var Highlighted := False;
- var Section := FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[AMemo.CaretLine]);
- if (Section <> scNone) and (AMemo.CaretVirtualSpace = 0) then begin
- var Pos := AMemo.CaretPosition;
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, OpeningBraces);
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, ClosingBraces);
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, ClosingBraces);
- Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, OpeningBraces);
- end;
- if not Highlighted then
- AMemo.SetBraceHighlighting(-1, -1);
- end;
- begin
- if Updated * [suContent, suSelection] = [] then
- Exit;
- var Memo := Sender as TIDEScintEdit;
- if (Memo = FErrorMemo) and ((FErrorMemo.ErrorLine < 0) or (FErrorMemo.CaretPosition <> FErrorMemo.ErrorCaretPosition)) then
- HideError;
- if Memo = FActiveMemo then begin
- UpdateCaretPosPanelAndBackNavStack;
- UpdateEditModeStatusPanel;
- end;
- UpdatePendingSquiggly(Memo);
- UpdateBraceHighlighting(Memo);
- UpdateOccurrenceIndicators(Memo);
- end;
- procedure TMainForm.MemoModifiedChange(Sender: TObject);
- begin
- if Sender = FActiveMemo then
- UpdateModifiedStatusPanel;
- end;
- procedure TMainForm.MemoCallTipArrowClick(Sender: TObject;
- const Up: Boolean);
- begin
- CallTipsHandleArrowClick(FActiveMemo, Up);
- end;
- procedure TMainForm.MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
- procedure MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer);
- begin
- for var I := 0 to FDebugEntriesCount-1 do
- if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
- (FDebugEntries[I].LineNumber >= FirstLine) then
- Inc(FDebugEntries[I].LineNumber, Count);
- for var I := FindResultsList.Items.Count-1 downto 0 do begin
- const FindResult = FindResultsList.Items.Objects[I] as TFindResult;
- if FindResult <> nil then begin
- if (PathCompare(FindResult.Filename, Memo.Filename) = 0) and
- (FindResult.Line >= FirstLine) then begin
- const NewLine = FindResult.Line + Count;
- UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine));
- end;
- end;
- end;
- if Assigned(Memo.LineState) and (FirstLine < Memo.LineStateCount) then begin
- { Grow FStateLine if necessary }
- var GrowAmount := (Memo.LineStateCount + Count) - Memo.LineStateCapacity;
- if GrowAmount > 0 then begin
- if GrowAmount < LineStateGrowAmount then
- GrowAmount := LineStateGrowAmount;
- ReallocMem(Memo.LineState, SizeOf(TLineState) * (Memo.LineStateCapacity + GrowAmount));
- Inc(Memo.LineStateCapacity, GrowAmount);
- end;
- { Shift existing line states and clear the new ones }
- for var I := Memo.LineStateCount-1 downto FirstLine do
- Memo.LineState[I + Count] := Memo.LineState[I];
- for var I := FirstLine to FirstLine + Count - 1 do
- Memo.LineState[I] := lnUnknown;
- Inc(Memo.LineStateCount, Count);
- end;
- if Memo.StepLine >= FirstLine then
- Inc(Memo.StepLine, Count);
- if Memo.ErrorLine >= FirstLine then
- Inc(Memo.ErrorLine, Count);
- var BreakPointsChanged := False;
- for var I := 0 to Memo.BreakPoints.Count-1 do begin
- const Line = Memo.BreakPoints[I];
- if Line >= FirstLine then begin
- Memo.BreakPoints[I] := Line + Count;
- BreakPointsChanged := True;
- end;
- end;
- if BreakPointsChanged then
- BuildAndSaveBreakPointLines(Memo);
- FNavStacks.LinesInserted(Memo, FirstLine, Count);
- end;
- procedure MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count,
- FirstAffectedLine: Integer);
- begin
- for var I := 0 to FDebugEntriesCount-1 do begin
- const DebugEntry: PDebugEntry = @FDebugEntries[I];
- if (DebugEntry.FileIndex = Memo.CompilerFileIndex) and
- (DebugEntry.LineNumber >= FirstLine) then begin
- if DebugEntry.LineNumber < FirstLine + Count then
- DebugEntry.LineNumber := -1
- else
- Dec(DebugEntry.LineNumber, Count);
- end;
- end;
- for var I := FindResultsList.Items.Count-1 downto 0 do begin
- const FindResult = FindResultsList.Items.Objects[I] as TFindResult;
- if FindResult <> nil then begin
- if (PathCompare(FindResult.Filename, Memo.Filename) = 0) and
- (FindResult.Line >= FirstLine) then begin
- if FindResult.Line < FirstLine + Count then
- FindResultsList.Items.Delete(I)
- else begin
- const NewLine = FindResult.Line - Count;
- UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine));
- end;
- end;
- end;
- end;
- if Assigned(Memo.LineState) then begin
- { Shift existing line states }
- if FirstLine < Memo.LineStateCount - Count then begin
- for var I := FirstLine to Memo.LineStateCount - Count - 1 do
- Memo.LineState[I] := Memo.LineState[I + Count];
- Dec(Memo.LineStateCount, Count);
- end
- else begin
- { There's nothing to shift because the last line(s) were deleted, or
- line(s) past FLineStateCount }
- if Memo.LineStateCount > FirstLine then
- Memo.LineStateCount := FirstLine;
- end;
- end;
- if Memo.StepLine >= FirstLine then begin
- if Memo.StepLine < FirstLine + Count then
- Memo.StepLine := -1
- else
- Dec(Memo.StepLine, Count);
- end;
- if Memo.ErrorLine >= FirstLine then begin
- if Memo.ErrorLine < FirstLine + Count then
- Memo.ErrorLine := -1
- else
- Dec(Memo.ErrorLine, Count);
- end;
- var BreakPointsChanged := False;
- for var I := Memo.BreakPoints.Count-1 downto 0 do begin
- const Line = Memo.BreakPoints[I];
- if Line >= FirstLine then begin
- if Line < FirstLine + Count then begin
- Memo.BreakPoints.Delete(I);
- BreakPointsChanged := True;
- end else begin
- Memo.BreakPoints[I] := Line - Count;
- BreakPointsChanged := True;
- end;
- end;
- end;
- if BreakPointsChanged then
- BuildAndSaveBreakPointLines(Memo);
- if FNavStacks.LinesDeleted(Memo, FirstLine, Count) then
- UpdateNavigationButtons;
- { We do NOT update FCurrentNavItem here so it might point to a line that's
- deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI }
- { When lines are deleted, Scintilla insists on moving all of the deleted
- lines' markers to the line on which the deletion started
- (FirstAffectedLine). This is bad for us as e.g. it can result in the line
- having two conflicting markers (or two of the same marker). There's no
- way to stop it from doing that, or to easily tell which markers came from
- which lines, so we simply delete and re-create all markers on the line. }
- UpdateLineMarkers(Memo, FirstAffectedLine);
- end;
- procedure MemoLinesInsertedOrDeleted(Memo: TIDEScintFileEdit);
- var
- FirstAffectedLine, Line, LinePos: Integer;
- begin
- Line := Memo.GetLineFromPosition(Info.StartPos);
- LinePos := Memo.GetPositionFromLine(Line);
- FirstAffectedLine := Line;
- { If the deletion/insertion does not start on the first character of Line,
- then we consider the first deleted/inserted line to be the following
- line (Line+1). This way, if you press Del at the end of line 1, the dot
- on line 2 is removed, while line 1's dot stays intact. }
- if Info.StartPos > LinePos then
- Inc(Line);
- if Info.LinesDelta > 0 then
- MemoLinesInserted(Memo, Line, Info.LinesDelta)
- else
- MemoLinesDeleted(Memo, Line, -Info.LinesDelta, FirstAffectedLine);
- end;
- var
- Memo: TIDEScintFileEdit;
- begin
- if not (Sender is TIDEScintFileEdit) then
- Exit;
- Memo := TIDEScintFileEdit(Sender);
- if Memo.OpeningFile then
- Exit;
- FModifiedAnySinceLastCompile := True;
- if FDebugging then
- FModifiedAnySinceLastCompileAndGo := True
- else begin
- { Modified while not debugging or opening a file; free the debug info and clear the dots }
- DestroyDebugInfo;
- end;
- if Info.LinesDelta <> 0 then
- MemoLinesInsertedOrDeleted(Memo);
- if Memo = FErrorMemo then begin
- { When the Delete key is pressed, the caret doesn't move, so reset
- FErrorCaretPosition to ensure that OnUpdateUI calls HideError }
- FErrorMemo.ErrorCaretPosition := -1;
- end;
- { The change should trigger restyling. Allow the styler to see the current
- caret position in case it wants to set a pending squiggly indicator. }
- Memo.ReportCaretPositionToStyler := True;
- end;
- procedure TMainForm.MemoCharAdded(Sender: TObject; Ch: AnsiChar);
- function LineIsBlank(const Line: Integer): Boolean;
- begin
- var S := FActiveMemo.Lines.RawLines[Line];
- Result := TScintEdit.RawStringIsBlank(S);
- end;
- begin
- if FOptions.AutoIndent and (Ch = FActiveMemo.LineEndingString[Length(FActiveMemo.LineEndingString)]) then begin
- { Add to the new line any (remaining) indentation from the previous line }
- const NewLine = FActiveMemo.CaretLine;
- var PreviousLine := NewLine-1;
- if PreviousLine >= 0 then begin
- const NewIndent = FActiveMemo.GetLineIndentation(NewLine);
- { If no indentation was moved from the previous line to the new line
- (i.e., there are no spaces/tabs directly to the right of the new
- caret position), and the previous line is completely empty (0 length),
- then use the indentation from the last line containing non-space
- characters. }
- if (NewIndent = 0) and (FActiveMemo.Lines.RawLineLengths[PreviousLine] = 0) then begin
- Dec(PreviousLine);
- while (PreviousLine >= 0) and LineIsBlank(PreviousLine) do
- Dec(PreviousLine);
- end;
- if PreviousLine >= 0 then begin
- const PreviousIndent = FActiveMemo.GetLineIndentation(PreviousLine);
- FActiveMemo.SetLineIndentation(NewLine, NewIndent + PreviousIndent);
- FActiveMemo.CaretPosition := FActiveMemo.GetPositionFromLineExpandedColumn(NewLine,
- PreviousIndent);
- end;
- end;
- end;
- AutoCompleteAndCallTipsHandleCharAdded(FActiveMemo, Ch);
- end;
- procedure TMainForm.MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
- function GetCodeVariableDebugEntryFromFileLineCol(FileIndex, Line, Col: Integer; out DebugEntry: PVariableDebugEntry): Boolean;
- var
- I: Integer;
- begin
- { FVariableDebugEntries uses 1-based line and column numbers }
- Inc(Line);
- Inc(Col);
- Result := False;
- for I := 0 to FVariableDebugEntriesCount-1 do begin
- if (FVariableDebugEntries[I].FileIndex = FileIndex) and
- (FVariableDebugEntries[I].LineNumber = Line) and
- (FVariableDebugEntries[I].Col = Col) then begin
- DebugEntry := @FVariableDebugEntries[I];
- Result := True;
- Break;
- end;
- end;
- end;
- function GetCodeColumnFromPosition(const Pos: Integer): Integer;
- var
- LinePos: Integer;
- S: TScintRawString;
- U: String;
- begin
- { [Code] lines get converted from the editor's UTF-8 to UTF-16 Strings when
- passed to the compiler. This can lead to column number discrepancies
- between Scintilla and ROPS. This code simulates the conversion to try to
- find out where ROPS thinks a Pos resides. }
- LinePos := FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos));
- S := FActiveMemo.GetRawTextRange(LinePos, Pos);
- U := FActiveMemo.ConvertRawStringToString(S);
- Result := Length(U);
- end;
- function FindVarOrFuncRange(const Pos: Integer): TScintRange;
- begin
- { Note: The GetPositionAfter is needed so that when the mouse is over a '.'
- between two words, it won't match the word to the left of the '.' }
- FActiveMemo.SetDefaultWordChars;
- Result.StartPos := FActiveMemo.GetWordStartPosition(FActiveMemo.GetPositionAfter(Pos), True);
- Result.EndPos := FActiveMemo.GetWordEndPosition(Pos, True);
- end;
- function FindConstRange(const Pos: Integer): TScintRange;
- var
- BraceLevel, ConstStartPos, Line, LineEndPos, I: Integer;
- C: AnsiChar;
- begin
- Result.StartPos := 0;
- Result.EndPos := 0;
- BraceLevel := 0;
- ConstStartPos := -1;
- Line := FActiveMemo.GetLineFromPosition(Pos);
- LineEndPos := FActiveMemo.GetLineEndPosition(Line);
- I := FActiveMemo.GetPositionFromLine(Line);
- while I < LineEndPos do begin
- if (I > Pos) and (BraceLevel = 0) then
- Break;
- C := FActiveMemo.GetByteAtPosition(I);
- if C = '{' then begin
- if FActiveMemo.GetByteAtPosition(I + 1) = '{' then
- Inc(I)
- else begin
- if BraceLevel = 0 then
- ConstStartPos := I;
- Inc(BraceLevel);
- end;
- end
- else if (C = '}') and (BraceLevel > 0) then begin
- Dec(BraceLevel);
- if (BraceLevel = 0) and (ConstStartPos <> -1) then begin
- if (Pos >= ConstStartPos) and (Pos <= I) then begin
- Result.StartPos := ConstStartPos;
- Result.EndPos := I + 1;
- Exit;
- end;
- ConstStartPos := -1;
- end;
- end;
- I := FActiveMemo.GetPositionAfter(I);
- end;
- end;
- procedure UpdateInfo(var Info: TScintHintInfo; const HintStr: String; const Range: TScintRange; const Memo: TIDEScintEdit);
- begin
- Info.HintStr := HintStr;
- Info.CursorRect.TopLeft := Memo.GetPointFromPosition(Range.StartPos);
- Info.CursorRect.BottomRight := Memo.GetPointFromPosition(Range.EndPos);
- Info.CursorRect.Bottom := Info.CursorRect.Top + Memo.LineHeight;
- Info.HideTimeout := High(Integer); { infinite }
- end;
- begin
- var Pos := FActiveMemo.GetPositionFromPoint(Info.CursorPos, True, True);
- if Pos < 0 then
- Exit;
- var Line := FActiveMemo.GetLineFromPosition(Pos);
- { Check if cursor is over a [Code] variable or function }
- if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]) = scCode then begin
- var VarOrFuncRange := FindVarOrFuncRange(Pos);
- if VarOrFuncRange.EndPos > VarOrFuncRange.StartPos then begin
- var HintStr := '';
- var DebugEntry: PVariableDebugEntry;
- if (FActiveMemo is TIDEScintFileEdit) and (FDebugClientWnd <> 0) and
- GetCodeVariableDebugEntryFromFileLineCol((FActiveMemo as TIDEScintFileEdit).CompilerFileIndex,
- Line, GetCodeColumnFromPosition(VarOrFuncRange.StartPos), DebugEntry) then begin
- var Output: String;
- case EvaluateVariableEntry(DebugEntry, Output) of
- 1: HintStr := Output;
- 2: HintStr := Output;
- else
- HintStr := 'Unknown error';
- end;
- end else begin
- var ClassMember := False;
- var Name := FActiveMemo.GetTextRange(VarOrFuncRange.StartPos, VarOrFuncRange.EndPos);
- var Index := 0;
- var Count: Integer;
- var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
- if Count = 0 then begin
- ClassMember := not ClassMember;
- FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
- end;
- while Index < Count do begin
- if Index <> 0 then
- FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index);
- if HintStr <> '' then
- HintStr := HintStr + #13;
- if FunctionDefinition.HeaderKind = hkFunction then
- HintStr := HintStr + 'function '
- else if FunctionDefinition.HeaderKind = hkProcedure then
- HintStr := HintStr + 'procedure '
- else
- HintStr := HintStr + 'constructor ';
- HintStr := HintStr + String(FunctionDefinition.ScriptFuncWithoutHeader);
- Inc(Index);
- end;
- end;
- if HintStr <> '' then begin
- UpdateInfo(Info, HintStr, VarOrFuncRange, FActiveMemo);
- Exit;
- end;
- end;
- end;
- if FDebugClientWnd <> 0 then begin
- { Check if cursor is over a constant }
- var ConstRange := FindConstRange(Pos);
- if ConstRange.EndPos > ConstRange.StartPos then begin
- var HintStr := FActiveMemo.GetTextRange(ConstRange.StartPos, ConstRange.EndPos);
- var Output: String;
- case EvaluateConstant(Info.HintStr, Output) of
- 1: HintStr := HintStr + ' = "' + Output + '"';
- 2: HintStr := HintStr + ' = Exception: ' + Output;
- else
- HintStr := HintStr + ' = Unknown error';
- end;
- UpdateInfo(Info, HintStr, ConstRange, FActiveMemo);
- end;
- end;
- end;
- procedure TMainForm.MainMemoDropFiles(Sender: TObject; X, Y: Integer;
- AFiles: TStrings);
- begin
- if (AFiles.Count > 0) and ConfirmCloseFile(True) then
- OpenFile(FMainMemo, AFiles[0], True);
- end;
- procedure TMainForm.MemoZoom(Sender: TObject);
- begin
- if not FSynchingZoom then begin
- FSynchingZoom := True;
- try
- for var Memo in FMemos do
- if Memo <> Sender then
- Memo.Zoom := (Sender as TScintEdit).Zoom;
- finally
- FSynchingZoom := False;
- end;
- end;
- end;
- procedure TMainForm.StatusBarResize(Sender: TObject);
- begin
- { Without this, on Windows XP with themes, the status bar's size grip gets
- corrupted as the form is resized }
- if StatusBar.HandleAllocated then
- InvalidateRect(StatusBar.Handle, nil, True);
- end;
- procedure TMainForm.WMDebuggerQueryVersion(var Message: TMessage);
- begin
- Message.Result := FCompilerVersion.BinVersion;
- end;
- procedure TMainForm.WMDebuggerHello(var Message: TMessage);
- var
- PID: DWORD;
- WantCodeText: Boolean;
- begin
- FDebugClientWnd := HWND(Message.WParam);
- { Save debug client process handle }
- if FDebugClientProcessHandle <> 0 then begin
- { Shouldn't get here, but just in case, don't leak a handle }
- CloseHandle(FDebugClientProcessHandle);
- FDebugClientProcessHandle := 0;
- end;
- PID := 0;
- if GetWindowThreadProcessId(FDebugClientWnd, @PID) <> 0 then
- FDebugClientProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE,
- False, PID);
- WantCodeText := Bool(Message.LParam);
- if WantCodeText then
- SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeTextA, FCompiledCodeText);
- SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeDebugInfoA, FCompiledCodeDebugInfo);
- UpdateRunMenu;
- end;
- procedure TMainForm.WMDebuggerGoodbye(var Message: TMessage);
- begin
- ReplyMessage(0);
- DebuggingStopped(True);
- end;
- procedure TMainForm.GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit; var DebugEntry: PDebugEntry);
- function GetMemoFromDebugEntryFileIndex(const FileIndex: Integer): TIDEScintFileEdit;
- var
- Memo: TIDEScintFileEdit;
- begin
- Result := nil;
- if FOptions.OpenIncludedFiles then begin
- for Memo in FFileMemos do begin
- if Memo.Used and (Memo.CompilerFileIndex = FileIndex) then begin
- Result := Memo;
- Exit;
- end;
- end;
- end else if FMainMemo.CompilerFileIndex = FileIndex then
- Result := FMainMemo;
- end;
- var
- I: Integer;
- begin
- for I := 0 to FDebugEntriesCount-1 do begin
- if (FDebugEntries[I].Kind = Kind) and (FDebugEntries[I].Index = Index) then begin
- Memo := GetMemoFromDebugEntryFileIndex(FDebugEntries[I].FileIndex);
- DebugEntry := @FDebugEntries[I];
- Exit;
- end;
- end;
- Memo := nil;
- DebugEntry := nil;
- end;
- procedure TMainForm.BringToForeground;
- { Brings our top window to the foreground. Called when pausing while
- debugging. }
- var
- TopWindow: HWND;
- begin
- TopWindow := GetThreadTopWindow;
- if TopWindow <> 0 then begin
- { First ask the debug client to call SetForegroundWindow() on our window.
- If we don't do this then Windows (98/2000+) will prevent our window from
- becoming activated if the debug client is currently in the foreground. }
- SendMessage(FDebugClientWnd, WM_DebugClient_SetForegroundWindow,
- WPARAM(TopWindow), 0);
- { Now call SetForegroundWindow() ourself. Why? When a remote thread calls
- SetForegroundWindow(), the request is queued; the window doesn't actually
- become active until the next time the window's thread checks the message
- queue. This call causes the window to become active immediately. }
- SetForegroundWindow(TopWindow);
- end;
- end;
- procedure TMainForm.DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
- var
- Memo: TIDEScintFileEdit;
- DebugEntry: PDebugEntry;
- LineNumber: Integer;
- begin
- GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
- if (Memo = nil) or (DebugEntry = nil) then
- Exit;
- LineNumber := DebugEntry.LineNumber;
- if LineNumber < 0 then { UninstExe has a DebugEntry but not a line number }
- Exit;
- if (LineNumber < Memo.LineStateCount) and
- (Memo.LineState[LineNumber] <> lnEntryProcessed) then begin
- Memo.LineState[LineNumber] := lnEntryProcessed;
- UpdateLineMarkers(Memo, LineNumber);
- end;
- if (FStepMode = smStepOut) and DebugEntry.StepOutMarker then
- FStepMode := smStepInto { Pause on next line }
- else if (FStepMode = smStepInto) or
- ((FStepMode = smStepOver) and not Intermediate) or
- ((FStepMode = smRunToCursor) and
- (FRunToCursorPoint.Kind = Integer(Message.WParam)) and
- (FRunToCursorPoint.Index = Message.LParam)) or
- (Memo.BreakPoints.IndexOf(LineNumber) <> -1) then begin
- MoveCaretAndActivateMemo(Memo, LineNumber, True);
- HideError;
- SetStepLine(Memo, LineNumber);
- BringToForeground;
- { Tell Setup to pause }
- Message.Result := 1;
- FPaused := True;
- FPausedAtCodeLine := DebugEntry.Kind = Ord(deCodeLine);
- UpdateRunMenu;
- UpdateCaption;
- end;
- end;
- procedure TMainForm.WMDebuggerStepped(var Message: TMessage);
- begin
- DebuggerStepped(Message, False);
- end;
- procedure TMainForm.WMDebuggerSteppedIntermediate(var Message: TMessage);
- begin
- DebuggerStepped(Message, True);
- end;
- procedure TMainForm.WMDPIChanged(var Message: TMessage);
- begin
- inherited;
- for var Memo in FMemos do
- Memo.DPIChanged(Message);
- end;
- procedure TMainForm.WMDebuggerException(var Message: TMessage);
- var
- Memo: TIDEScintFileEdit;
- DebugEntry: PDebugEntry;
- LineNumber: Integer;
- S: String;
- begin
- if FOptions.PauseOnDebuggerExceptions then begin
- GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
- if DebugEntry <> nil then
- LineNumber := DebugEntry.LineNumber
- else
- LineNumber := -1;
- if (Memo <> nil) and (LineNumber >= 0) then begin
- MoveCaretAndActivateMemo(Memo, LineNumber, True);
- SetStepLine(Memo, -1);
- SetErrorLine(Memo, LineNumber);
- end;
- BringToForeground;
- { Tell Setup to pause }
- Message.Result := 1;
- FPaused := True;
- FPausedAtCodeLine := (DebugEntry <> nil) and (DebugEntry.Kind = Ord(deCodeLine));
- UpdateRunMenu;
- UpdateCaption;
- ReplyMessage(Message.Result); { so that Setup enters a paused state now }
- if LineNumber >= 0 then begin
- S := Format('Line %d:' + SNewLine + '%s', [LineNumber + 1, AddPeriod(FDebuggerException)]);
- if (Memo <> nil) and (Memo.Filename <> '') then
- S := Memo.Filename + SNewLine2 + S;
- MsgBox(S, 'Runtime Error', mbCriticalError, mb_Ok)
- end else
- MsgBox(AddPeriod(FDebuggerException), 'Runtime Error', mbCriticalError, mb_Ok);
- end;
- end;
- procedure TMainForm.WMDebuggerSetForegroundWindow(var Message: TMessage);
- begin
- SetForegroundWindow(HWND(Message.WParam));
- end;
- procedure TMainForm.WMDebuggerCallStackCount(var Message: TMessage);
- begin
- FCallStackCount := Message.WParam;
- end;
- procedure TMainForm.WMCopyData(var Message: TWMCopyData);
- var
- S: String;
- begin
- case Message.CopyDataStruct.dwData of
- CD_Debugger_ReplyW: begin
- FReplyString := '';
- SetString(FReplyString, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- Message.Result := 1;
- end;
- CD_Debugger_ExceptionW: begin
- SetString(FDebuggerException, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- Message.Result := 1;
- end;
- CD_Debugger_UninstExeW: begin
- SetString(FUninstExe, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div sizeOf(Char));
- Message.Result := 1;
- end;
- CD_Debugger_LogMessageW: begin
- SetString(S, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- DebugLogMessage(S);
- Message.Result := 1;
- end;
- CD_Debugger_TempDirW: begin
- { Paranoia: Store it in a local variable first. That way, if there's
- a problem reading the string FTempDir will be left unmodified.
- Gotta be extra careful when storing a path we'll be deleting. }
- SetString(S, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- { Extreme paranoia: If there are any embedded nulls, discard it. }
- if Pos(#0, S) <> 0 then
- S := '';
- FTempDir := S;
- Message.Result := 1;
- end;
- CD_Debugger_CallStackW: begin
- SetString(S, PChar(Message.CopyDataStruct.lpData),
- Message.CopyDataStruct.cbData div SizeOf(Char));
- DebugShowCallStack(S, FCallStackCount);
- end;
- end;
- end;
- function TMainForm.DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
- begin
- if Assigned(AMemo.LineState) then begin
- AMemo.LineStateCapacity := 0;
- AMemo.LineStateCount := 0;
- FreeMem(AMemo.LineState);
- AMemo.LineState := nil;
- Result := True;
- end else
- Result := False;
- end;
- procedure TMainForm.DestroyDebugInfo;
- var
- HadDebugInfo: Boolean;
- Memo: TIDEScintFileEdit;
- begin
- HadDebugInfo := False;
- for Memo in FFileMemos do
- if DestroyLineState(Memo) then
- HadDebugInfo := True;
- FDebugEntriesCount := 0;
- FreeMem(FDebugEntries);
- FDebugEntries := nil;
- FVariableDebugEntriesCount := 0;
- FreeMem(FVariableDebugEntries);
- FVariableDebugEntries := nil;
- FCompiledCodeText := '';
- FCompiledCodeDebugInfo := '';
- { Clear all dots and reset breakpoint icons (unless exiting; no point) }
- if HadDebugInfo and not(csDestroying in ComponentState) then
- UpdateAllMemosLineMarkers;
- end;
- var
- PrevCompilerFileIndex: Integer;
- PrevMemo: TIDEScintFileEdit;
- procedure TMainForm.ParseDebugInfo(DebugInfo: Pointer);
- function GetMemoFromCompilerFileIndex(const CompilerFileIndex: Integer): TIDEScintFileEdit;
- var
- Memo: TIDEScintFileEdit;
- begin
- if (PrevCompilerFileIndex <> CompilerFileIndex) then begin
- PrevMemo := nil;
- for Memo in FFileMemos do begin
- if Memo.Used and (Memo.CompilerFileIndex = CompilerFileIndex) then begin
- PrevMemo := Memo;
- Break;
- end;
- end;
- PrevCompilerFileIndex := CompilerFileIndex;
- end;
- Result := PrevMemo;
- end;
- { This creates and fills the DebugEntries and Memo LineState arrays }
- var
- Header: PDebugInfoHeader;
- Memo: TIDEScintFileEdit;
- Size: Cardinal;
- I: Integer;
- begin
- DestroyDebugInfo;
- Header := DebugInfo;
- if (Header.ID <> DebugInfoHeaderID) or
- (Header.Version <> DebugInfoHeaderVersion) then
- raise Exception.Create('Unrecognized debug info format');
- try
- for Memo in FFileMemos do begin
- if Memo.Used then begin
- I := Memo.Lines.Count;
- Memo.LineState := AllocMem(SizeOf(TLineState) * (I + LineStateGrowAmount));
- Memo.LineStateCapacity := I + LineStateGrowAmount;
- Memo.LineStateCount := I;
- end;
- end;
- Inc(Cardinal(DebugInfo), SizeOf(Header^));
- FDebugEntriesCount := Header.DebugEntryCount;
- Size := FDebugEntriesCount * SizeOf(TDebugEntry);
- GetMem(FDebugEntries, Size);
- Move(DebugInfo^, FDebugEntries^, Size);
- for I := 0 to FDebugEntriesCount-1 do
- Dec(FDebugEntries[I].LineNumber);
- Inc(Cardinal(DebugInfo), Size);
- FVariableDebugEntriesCount := Header.VariableDebugEntryCount;
- Size := FVariableDebugEntriesCount * SizeOf(TVariableDebugEntry);
- GetMem(FVariableDebugEntries, Size);
- Move(DebugInfo^, FVariableDebugEntries^, Size);
- Inc(Cardinal(DebugInfo), Size);
- SetString(FCompiledCodeText, PAnsiChar(DebugInfo), Header.CompiledCodeTextLength);
- Inc(Cardinal(DebugInfo), Header.CompiledCodeTextLength);
- SetString(FCompiledCodeDebugInfo, PAnsiChar(DebugInfo), Header.CompiledCodeDebugInfoLength);
- PrevCompilerFileIndex := UnknownCompilerFileIndex;
- for I := 0 to FDebugEntriesCount-1 do begin
- if FDebugEntries[I].LineNumber >= 0 then begin
- Memo := GetMemoFromCompilerFileIndex(FDebugEntries[I].FileIndex);
- if (Memo <> nil) and (FDebugEntries[I].LineNumber < Memo.LineStateCount) then begin
- if Memo.LineState[FDebugEntries[I].LineNumber] = lnUnknown then
- Memo.LineState[FDebugEntries[I].LineNumber] := lnHasEntry;
- end;
- end;
- end;
- UpdateAllMemosLineMarkers;
- except
- DestroyDebugInfo;
- raise;
- end;
- end;
- procedure TMainForm.ResetAllMemosLineState;
- { Changes green dots back to grey dots }
- var
- Memo: TIDEScintFileEdit;
- I: Integer;
- begin
- for Memo in FFileMemos do begin
- if Memo.Used and Assigned(Memo.LineState) then begin
- for I := 0 to Memo.LineStateCount-1 do begin
- if Memo.LineState[I] = lnEntryProcessed then begin
- Memo.LineState[I] := lnHasEntry;
- UpdateLineMarkers(Memo, I);
- end;
- end;
- end;
- end;
- end;
- procedure TMainForm.CheckIfTerminated;
- var
- H: THandle;
- begin
- if FDebugging then begin
- { Check if the process hosting the debug client (e.g. Setup or the
- uninstaller second phase) has terminated. If the debug client hasn't
- connected yet, check the initial process (e.g. SetupLdr or the
- uninstaller first phase) instead. }
- if FDebugClientWnd <> 0 then
- H := FDebugClientProcessHandle
- else
- H := FProcessHandle;
- if WaitForSingleObject(H, 0) <> WAIT_TIMEOUT then
- DebuggingStopped(True);
- end;
- end;
- procedure TMainForm.DebuggingStopped(const WaitForTermination: Boolean);
- function GetExitCodeText: String;
- var
- ExitCode: DWORD;
- begin
- { Note: When debugging an uninstall, this will get the exit code off of
- the first phase process, since that's the exit code users will see when
- running the uninstaller outside the debugger. }
- case WaitForSingleObject(FProcessHandle, 0) of
- WAIT_OBJECT_0:
- begin
- if GetExitCodeProcess(FProcessHandle, ExitCode) then begin
- { If the high bit is set, the process was killed uncleanly (e.g.
- by a debugger). Show the exit code as hex in that case. }
- if ExitCode and $80000000 <> 0 then
- Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: 0x%.8x', [ExitCode])
- else
- Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: %u', [ExitCode]);
- end
- else
- Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (GetExitCodeProcess failed)';
- end;
- WAIT_TIMEOUT:
- Result := DebugTargetStrings[FDebugTarget] + ' is still running; can''t get exit code';
- else
- Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (WaitForSingleObject failed)';
- end;
- end;
- var
- ExitCodeText: String;
- begin
- if WaitForTermination then begin
- { Give the initial process time to fully terminate so we can successfully
- get its exit code }
- WaitForSingleObject(FProcessHandle, 5000);
- end;
- FDebugging := False;
- FDebugClientWnd := 0;
- ExitCodeText := GetExitCodeText;
- if FDebugClientProcessHandle <> 0 then begin
- CloseHandle(FDebugClientProcessHandle);
- FDebugClientProcessHandle := 0;
- end;
- CloseHandle(FProcessHandle);
- FProcessHandle := 0;
- FTempDir := '';
- CheckIfTerminatedTimer.Enabled := False;
- HideError;
- SetStepLine(FStepMemo, -1);
- UpdateRunMenu;
- UpdateCaption;
- DebugLogMessage('*** ' + ExitCodeText);
- StatusBar.Panels[spExtraStatus].Text := ' ' + ExitCodeText;
- end;
- procedure TMainForm.DetachDebugger;
- begin
- CheckIfTerminated;
- if not FDebugging then Exit;
- SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Detach, 0, 0);
- DebuggingStopped(False);
- end;
- function TMainForm.AskToDetachDebugger: Boolean;
- begin
- if FDebugClientWnd = 0 then begin
- MsgBox('Please stop the running ' + DebugTargetStrings[FDebugTarget] + ' process before performing this command.',
- SCompilerFormCaption, mbError, MB_OK);
- Result := False;
- end else if MsgBox('This command will detach the debugger from the running ' + DebugTargetStrings[FDebugTarget] + ' process. Continue?',
- SCompilerFormCaption, mbError, MB_OKCANCEL) = IDOK then begin
- DetachDebugger;
- Result := True;
- end else
- Result := False;
- end;
- procedure TMainForm.RMenuClick(Sender: TObject);
- begin
- UpdateRunMenu2(RMenu);
- end;
- procedure TMainForm.BreakPointsPopupMenuClick(Sender: TObject);
- begin
- UpdateBreakPointsMenu(Sender as TMenuItem);
- end;
- procedure TMainForm.UpdateKeyMapping;
- type
- TKeyMappedMenu = TPair<TMenuItem, TPair<TShortcut, TToolButton>>;
- function KMM(const MenuItem: TMenuItem; const DelphiKey: Word; const DelphiShift: TShiftState;
- const VisualStudioKey: Word; const VisualStudioShift: TShiftState;
- const ToolButton: TToolButton = nil): TKeyMappedMenu;
- begin
- var AShortCut: TShortCut;
- case FOptions.KeyMappingType of
- kmtDelphi: AShortCut := ShortCut(DelphiKey, DelphiShift);
- kmtVisualStudio: AShortCut := ShortCut(VisualStudioKey, VisualStudioShift);
- else
- raise Exception.Create('Unknown FOptions.KeyMappingType');
- end;
- Result := TKeyMappedMenu.Create(MenuItem, TPair<TShortcut, TToolButton>.Create(AShortcut, ToolButton)); { These are records so no need to free }
- end;
- begin
- var KeyMappedMenus := [
- KMM(FPrint, Ord('P'), [ssCtrl], 0, []), { Also see EGotoFile below }
- KMM(EFindRegEx, Ord('R'), [ssCtrl, ssAlt], Ord('R'), [ssAlt]),
- KMM(EGotoFile, VK_F12, [ssCtrl], Ord('P'), [ssCtrl]), { Also see FPrint above }
- KMM(BCompile, VK_F9, [ssCtrl], Ord('B'), [ssCtrl], CompileButton), { Also FCompileShortCut2 below }
- KMM(RRun, VK_F9, [], VK_F5, [], RunButton),
- KMM(RRunToCursor, VK_F4, [], VK_F10, [ssCtrl]),
- KMM(RStepInto, VK_F7, [], VK_F11, []),
- KMM(RStepOver, VK_F8, [], VK_F10, []),
- KMM(RStepOut, VK_F8, [ssShift], VK_F11, [ssShift]),
- KMM(RToggleBreakPoint, VK_F5, [], VK_F9, []),
- KMM(RDeleteBreakPoints, VK_F5, [ssShift, ssCtrl], VK_F9, [ssShift, ssCtrl]),
- KMM(RTerminate, VK_F2, [ssCtrl], VK_F5, [ssShift], TerminateButton),
- KMM(REvaluate, VK_F7, [ssCtrl], VK_F9, [ssShift])];
- FKeyMappedMenus.Clear;
- for var KeyMappedMenu in KeyMappedMenus do begin
- var ShortCut := KeyMappedMenu.Value.Key;
- var ToolButton := KeyMappedMenu.Value.Value;
- KeyMappedMenu.Key.ShortCut := ShortCut;
- if ToolButton <> nil then begin
- var MenuItem := KeyMappedMenu.Key;
- ToolButton.Hint := Format('%s (%s)', [RemoveAccelChar(MenuItem.Caption), NewShortCutToText(ShortCut)]);
- end;
- FKeyMappedMenus.Add(ShortCut, ToolButton);
- end;
- { Set fake shortcuts on any duplicates of the above in popup menus }
- SetFakeShortCut(RToggleBreakPoint2, RToggleBreakPoint.ShortCut);
- SetFakeShortCut(RDeleteBreakPoints2, RDeleteBreakPoints.ShortCut);
- { Handle three special cases:
- -The Nav buttons have no corresponding menu item and also no ShortCut property
- so they need special handling
- -Visual Studio and Delphi have separate Compile and Build shortcuts and the
- Compile shortcut is displayed by the menu and is set above but we want to
- allow the Build shortcuts as well for our single Build/Compile command
- -If Visual Studio Code is selected then Ctrl+F is used for EGotoFile and FPrint
- becomes shortcut-less }
- FBackNavButtonShortCut := ShortCut(VK_LEFT, [ssAlt]);
- FForwardNavButtonShortCut := ShortCut(VK_RIGHT, [ssAlt]);
- case FOptions.KeyMappingType of
- kmtDelphi:
- begin
- FBackNavButtonShortCut2 := 0;
- FForwardNavButtonShortCut2 := 0;
- FCompileShortCut2 := ShortCut(VK_F9, [ssShift]);
- end;
- kmtVisualStudio:
- begin
- FBackNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl]);
- FForwardNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl, ssShift]);
- FCompileShortCut2 := ShortCut(VK_F7, []);
- end;
- else
- raise Exception.Create('Unknown FOptions.KeyMappingType');
- end;
- BackNavButton.Hint := Format('Back (%s)', [NewShortCutToText(FBackNavButtonShortCut)]);
- FKeyMappedMenus.Add(FBackNavButtonShortCut, nil);
- ForwardNavButton.Hint := Format('Forward (%s)', [NewShortCutToText(FForwardNavButtonShortCut)]);
- FKeyMappedMenus.Add(FForwardNavButtonShortCut, nil);
- if FOptions.KeyMappingType = kmtVisualStudio then
- FPrint.ShortCut := 0;
- end;
- procedure TMainForm.UpdateTheme;
- procedure SetListBoxWindowTheme(const ListBox: TListBox);
- begin
- ListBox.Font.Color := FTheme.Colors[tcFore];
- ListBox.Color := FTheme.Colors[tcBack];
- ListBox.Invalidate;
- SetControlWindowTheme(ListBox, FTheme.Dark);
- end;
- begin
- FTheme.Typ := FOptions.ThemeType;
- {$IF CompilerVersion >= 36.0 }
- { For MainForm the active style only impacts message boxes and tooltips: FMemos, ToolbarPanel,
- UpdatePanel, SplitPanel and the 4 ListBoxes all ignore it because their StyleName property is set
- to 'Windows' always, either by the .dfm or by code. Additionally, for scrollbars and StatusBar,
- MainForm's StyleElements is empty. Menus ignore it because shMenus is removed from
- TStyleManager.SystemHooks at startup. }
- if FTheme.Dark then
- TStyleManager.TrySetStyle('Windows11 Modern Dark')
- else
- TStyleManager.TrySetStyle('Windows');
- { For some reason only MainForm needs this: with StyleName set to an empty string, dialog boxes
- it opens, such as MsgBox, look broken }
- StyleName := TStyleManager.ActiveStyle.Name;
- {$ENDIF}
- if not Application.ShowMainForm then
- Exit;
- SetHelpFileDark(FTheme.Dark);
- InitFormTheme(Self);
- ToolbarPanel.Color := FTheme.Colors[tcToolBack];
- for var Memo in FMemos do begin
- Memo.UpdateThemeColorsAndStyleAttributes;
- SetControlWindowTheme(Memo, FTheme.Dark);
- end;
- SetListBoxWindowTheme(CompilerOutputList);
- SetListBoxWindowTheme(DebugOutputList);
- SetListBoxWindowTheme(DebugCallStackList);
- SetListBoxWindowTheme(FindResultsList);
- ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.ToolBarImageCollection[FTheme.Dark];
- ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.MarkersAndACImageCollection[FTheme.Dark];
-
- UpdateThemeData(True);
- UpdateBevel1Visibility;
- UpdateMarginsAndAutoCompleteIcons;
- SplitPanel.ParentBackground := False;
- SplitPanel.Color := FTheme.Colors[tcSplitterBack];
- FMenuDarkBackgroundBrush.Color := FTheme.Colors[tcToolBack];
- FMenuDarkHotOrSelectedBrush.Color := $2C2C2C; { Same as themed menu drawn by Windows 11, which is close to Colors[tcBack] }
- DrawMenuBar(Handle);
- { SetPreferredAppMode doesn't work without FlushMenuThemes here: it would have
- to be called before the form is created to have an effect without
- FlushMenuThemes. So don't call SetPreferredAppMode if FlushMenuThemes is
- missing. }
- if Assigned(SetPreferredAppMode) and Assigned(FlushMenuThemes) then begin
- FMenuImageList := ThemedToolbarVirtualImageList;
- if FTheme.Dark then
- SetPreferredAppMode(PAM_FORCEDARK)
- else
- SetPreferredAppMode(PAM_FORCELIGHT);
- FlushMenuThemes;
- end else
- FMenuImageList := LightToolbarVirtualImageList;
- end;
- procedure TMainForm.UpdateThemeData(const Open: Boolean);
- procedure CloseThemeDataIfNeeded(var ThemeData: HTHEME);
- begin
- if ThemeData <> 0 then begin
- CloseThemeData(ThemeData);
- ThemeData := 0;
- end;
- end;
- begin
- CloseThemeDataIfNeeded(FProgressThemeData);
- CloseThemeDataIfNeeded(FMenuThemeData);
- CloseThemeDataIfNeeded(FToolbarThemeData);
- CloseThemeDataIfNeeded(FStatusBarThemeData);
- if Open and UseThemes then begin
- FProgressThemeData := OpenThemeData(Handle, 'Progress');
- FMenuThemeData := OpenThemeData(Handle, 'Menu');
- if FTheme.Dark then
- FToolbarThemeData := OpenThemeData(Handle, 'DarkMode::Toolbar');
- if FToolbarThemeData = 0 then
- FToolbarThemeData := OpenThemeData(Handle, 'Toolbar');
- FStatusBarThemeData := OpenThemeData(Handle, 'Status');
- end;
- end;
- procedure TMainForm.UpdateUpdatePanel;
- begin
- UpdatePanel.Visible := FUpdatePanelMessages.Count > 0;
- if UpdatePanel.Visible then begin
- var MessageToShowIndex := FUpdatePanelMessages.Count-1;
- UpdateLinkLabel.Tag := MessageToShowIndex;
- UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg;
- if not FHighContrastActive then
- UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
- if FUpdatePanelMessages[MessageToShowIndex].ConfigIdent.StartsWith('Purchase') then
- FDonateImageMenuItem := HPurchase
- else
- FDonateImageMenuItem := HDonate;
- UpdatePanelDonateBitBtn.Hint := RemoveAccelChar(FDonateImageMenuItem.Caption)
- end;
- UpdateBevel1Visibility;
- end;
- procedure TMainForm.CompileIfNecessary;
- function UnopenedIncludedFileModifiedSinceLastCompile: Boolean;
- var
- IncludedFile: TIncludedFile;
- NewTime: TFileTime;
- begin
- Result := False;
- for IncludedFile in FIncludedFiles do begin
- if (IncludedFile.Memo = nil) and IncludedFile.HasLastWriteTime and
- GetLastWriteTimeOfFile(IncludedFile.Filename, @NewTime) and
- (CompareFileTime(IncludedFile.LastWriteTime, NewTime) <> 0) then begin
- Result := True;
- Exit;
- end;
- end;
- end;
- begin
- CheckIfTerminated;
- { Display warning if the user modified the script while running - does not support unopened included files }
- if FDebugging and FModifiedAnySinceLastCompileAndGo then begin
- if MsgBox('The changes you made will not take effect until you ' +
- 're-compile.' + SNewLine2 + 'Continue running anyway?',
- SCompilerFormCaption, mbError, MB_YESNO) <> IDYES then
- Abort;
- FModifiedAnySinceLastCompileAndGo := False;
- { The process may have terminated while the message box was up; check,
- and if it has, we want to recompile below }
- CheckIfTerminated;
- end;
- if not FDebugging and (FModifiedAnySinceLastCompile or UnopenedIncludedFileModifiedSinceLastCompile) then
- CompileFile('', False);
- end;
- procedure TMainForm.Go(const AStepMode: TStepMode);
- procedure StartProcess;
- var
- RunFilename, RunParameters, WorkingDir: String;
- Info: TShellExecuteInfo;
- SaveFocusWindow: HWND;
- WindowList: Pointer;
- ShellExecuteResult: BOOL;
- ErrorCode: DWORD;
- begin
- if FDebugTarget = dtUninstall then begin
- if FUninstExe = '' then
- raise Exception.Create(SCompilerNeedUninstExe);
- RunFilename := FUninstExe;
- end else begin
- if FCompiledExe = '' then
- raise Exception.Create(SCompilerNeedCompiledExe);
- RunFilename := FCompiledExe;
- end;
- { The UInt32 cast prevents sign extension }
- RunParameters := Format('/DEBUGWND=$%x ', [UInt32(Handle)]) + FRunParameters;
- ResetAllMemosLineState;
- DebugOutputList.Clear;
- SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugCallStackList.Clear;
- SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- if not (OutputTabSet.TabIndex in [tiDebugOutput, tiDebugCallStack]) then
- OutputTabSet.TabIndex := tiDebugOutput;
- SetStatusPanelVisible(True);
- FillChar(Info, SizeOf(Info), 0);
- Info.cbSize := SizeOf(Info);
- Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT or
- SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOZONECHECKS;
- Info.Wnd := Handle;
- if FOptions.RunAsDifferentUser then
- Info.lpVerb := 'runas'
- else
- Info.lpVerb := 'open';
- Info.lpFile := PChar(RunFilename);
- Info.lpParameters := PChar(RunParameters);
- WorkingDir := PathExtractDir(RunFilename);
- Info.lpDirectory := PChar(WorkingDir);
- Info.nShow := SW_SHOWNORMAL;
- { When the RunAsDifferentUser option is enabled, it's this process that
- waits on the UAC dialog, not Setup(Ldr), so we need to disable windows to
- prevent the user from clicking other things before the UAC dialog is
- dismissed (which is definitely a possibility if the "Switch to the secure
- desktop when prompting for elevation" setting is disabled in Group
- Policy). }
- SaveFocusWindow := GetFocus;
- WindowList := DisableTaskWindows(Handle);
- try
- { Also temporarily remove the focus since a disabled window's children can
- still receive keystrokes. This is needed if Windows doesn't switch to
- the secure desktop immediately and instead shows a flashing taskbar
- button that the user must click (which happened on Windows Vista; I'm
- unable to reproduce it on Windows 11). }
- Windows.SetFocus(0);
- ShellExecuteResult := ShellExecuteEx(@Info);
- ErrorCode := GetLastError;
- finally
- EnableTaskWindows(WindowList);
- Windows.SetFocus(SaveFocusWindow);
- end;
- if not ShellExecuteResult then begin
- { Don't display error message if user clicked Cancel at UAC dialog }
- if ErrorCode = ERROR_CANCELLED then
- Abort;
- raise Exception.CreateFmt(SCompilerExecuteSetupError2, [RunFilename,
- ErrorCode, Win32ErrorString(ErrorCode)]);
- end;
- FDebugging := True;
- FPaused := False;
- FProcessHandle := Info.hProcess;
- CheckIfTerminatedTimer.Enabled := True;
- UpdateRunMenu;
- UpdateCaption;
- DebugLogMessage('*** ' + DebugTargetStrings[FDebugTarget] + ' started');
- end;
- procedure ContinueProcessIfPaused(const AStepMode: TStepMode);
- begin
- if FPaused then begin
- FPaused := False;
- UpdateRunMenu;
- UpdateCaption;
- if DebugCallStackList.Items.Count > 0 then begin
- DebugCallStackList.Clear;
- SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- DebugCallStackList.Update;
- end;
- { Tell it to continue }
- SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Continue,
- Ord(AStepMode = smStepOver), 0);
- end;
- end;
- begin
- CompileIfNecessary;
- FStepMode := AStepMode;
- HideError;
- SetStepLine(FStepMemo, -1);
- if FDebugging then
- ContinueProcessIfPaused(AStepMode)
- else
- StartProcess;
- end;
- function TMainForm.EvaluateConstant(const S: String;
- out Output: String): Integer;
- begin
- { This is about evaluating constants like 'app' and not [Code] variables }
- FReplyString := '';
- Result := SendCopyDataMessageStr(FDebugClientWnd, Handle,
- CD_DebugClient_EvaluateConstantW, S);
- if Result > 0 then
- Output := FReplyString;
- end;
- function TMainForm.EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
- out Output: String): Integer;
- begin
- FReplyString := '';
- Result := SendCopyDataMessage(FDebugClientWnd, Handle, CD_DebugClient_EvaluateVariableEntry,
- DebugEntry, SizeOf(DebugEntry^));
- if Result > 0 then
- Output := FReplyString;
- end;
- procedure TMainForm.RRunClick(Sender: TObject);
- begin
- Go(smRun);
- end;
- procedure TMainForm.RParametersClick(Sender: TObject);
- begin
- ReadMRUParametersList;
- InputQueryCombo('Run Parameters', 'Command line parameters for ' + DebugTargetStrings[dtSetup] +
- ' and ' + DebugTargetStrings[dtUninstall] + ':', FRunParameters, FMRUParametersList);
- if FRunParameters <> '' then
- ModifyMRUParametersList(FRunParameters, True);
- end;
- procedure TMainForm.RPauseClick(Sender: TObject);
- begin
- if FDebugging and not FPaused then begin
- if FStepMode <> smStepInto then begin
- FStepMode := smStepInto;
- UpdateCaption;
- end
- else
- MsgBox('A pause is already pending.', SCompilerFormCaption, mbError,
- MB_OK);
- end;
- end;
- procedure TMainForm.RRunToCursorClick(Sender: TObject);
- function GetDebugEntryFromMemoAndLineNumber(Memo: TIDEScintFileEdit; LineNumber: Integer;
- var DebugEntry: TDebugEntry): Boolean;
- var
- I: Integer;
- begin
- Result := False;
- for I := 0 to FDebugEntriesCount-1 do begin
- if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
- (FDebugEntries[I].LineNumber = LineNumber) then begin
- DebugEntry := FDebugEntries[I];
- Result := True;
- Break;
- end;
- end;
- end;
- begin
- CompileIfNecessary;
- if not GetDebugEntryFromMemoAndLineNumber((FActiveMemo as TIDEScintFileEdit), FActiveMemo.CaretLine, FRunToCursorPoint) then begin
- MsgBox('No code was generated for the current line.', SCompilerFormCaption,
- mbError, MB_OK);
- Exit;
- end;
- Go(smRunToCursor);
- end;
- procedure TMainForm.RStepIntoClick(Sender: TObject);
- begin
- Go(smStepInto);
- end;
- procedure TMainForm.RStepOutClick(Sender: TObject);
- begin
- if FPausedAtCodeLine then
- Go(smStepOut)
- else
- Go(smStepInto);
- end;
- procedure TMainForm.RStepOverClick(Sender: TObject);
- begin
- Go(smStepOver);
- end;
- procedure TMainForm.RTerminateClick(Sender: TObject);
- var
- S, Dir: String;
- begin
- S := 'This will unconditionally terminate the running ' +
- DebugTargetStrings[FDebugTarget] + ' process. Continue?';
- if FDebugTarget = dtSetup then
- S := S + #13#10#13#10'Note that if ' + DebugTargetStrings[FDebugTarget] + ' ' +
- 'is currently in the installation phase, any changes made to the ' +
- 'system thus far will not be undone, nor will uninstall data be written.';
- if MsgBox(S, 'Terminate', mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDYES then
- Exit;
- CheckIfTerminated;
- if FDebugging then begin
- DebugLogMessage('*** Terminating process');
- Win32Check(TerminateProcess(FDebugClientProcessHandle, 6));
- if (WaitForSingleObject(FDebugClientProcessHandle, 5000) <> WAIT_TIMEOUT) and
- (FTempDir <> '') then begin
- Dir := FTempDir;
- FTempDir := '';
- DebugLogMessage('*** Removing left-over temporary directory: ' + Dir);
- { Sleep for a bit to allow files to be unlocked by Windows,
- otherwise it fails intermittently (with Hyper-Threading, at least) }
- Sleep(50);
- if not DeleteDirTree(Dir) and DirExists(Dir) then
- DebugLogMessage('*** Failed to remove temporary directory');
- end;
- DebuggingStopped(True);
- end;
- end;
- procedure TMainForm.REvaluateClick(Sender: TObject);
- var
- Output: String;
- begin
- if InputQuery('Evaluate', 'Constant to evaluate (e.g., "{app}"):',
- FLastEvaluateConstantText) then begin
- case EvaluateConstant(FLastEvaluateConstantText, Output) of
- 1: MsgBox(Output, 'Evaluate Result', mbInformation, MB_OK);
- 2: MsgBox(Output, 'Evaluate Error', mbError, MB_OK);
- else
- MsgBox('An unknown error occurred.', 'Evaluate Error', mbError, MB_OK);
- end;
- end;
- end;
- procedure TMainForm.CheckIfTerminatedTimerTimer(Sender: TObject);
- begin
- { In cases of normal Setup termination, we receive a WM_Debugger_Goodbye
- message. But in case we don't get that, use a timer to periodically check
- if the process is no longer running. }
- CheckIfTerminated;
- end;
- procedure TMainForm.POutputListCopyClick(Sender: TObject);
- var
- ListBox: TListBox;
- Text: String;
- I: Integer;
- begin
- if CompilerOutputList.Visible then
- ListBox := CompilerOutputList
- else if DebugOutputList.Visible then
- ListBox := DebugOutputList
- else if DebugCallStackList.Visible then
- ListBox := DebugCallStackList
- else
- ListBox := FindResultsList;
- Text := '';
- if ListBox.SelCount > 0 then begin
- for I := 0 to ListBox.Items.Count-1 do begin
- if ListBox.Selected[I] then begin
- if Text <> '' then
- Text := Text + SNewLine;
- Text := Text + ListBox.Items[I];
- end;
- end;
- end;
- Clipboard.AsText := Text;
- end;
- procedure TMainForm.POutputListSelectAllClick(Sender: TObject);
- var
- ListBox: TListBox;
- I: Integer;
- begin
- if CompilerOutputList.Visible then
- ListBox := CompilerOutputList
- else if DebugOutputList.Visible then
- ListBox := DebugOutputList
- else if DebugCallStackList.Visible then
- ListBox := DebugCallStackList
- else
- ListBox := FindResultsList;
- ListBox.Items.BeginUpdate;
- try
- for I := 0 to ListBox.Items.Count-1 do
- ListBox.Selected[I] := True;
- finally
- ListBox.Items.EndUpdate;
- end;
- end;
- procedure TMainForm.OutputListKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if Shift = [ssCtrl] then begin
- if Key = Ord('C') then
- POutputListCopyClick(Sender)
- else if Key = Ord('A') then
- POutputListSelectAllClick(Sender);
- end;
- end;
- procedure TMainForm.AppOnIdle(Sender: TObject; var Done: Boolean);
- begin
- { For an explanation of this, see the comment where HandleMessage is called }
- if FCompiling then
- Done := False;
- FBecameIdle := True;
- end;
- procedure TMainForm.EGotoFileClick(Sender: TObject);
- begin
- const GotoFileForm = TGotoFileForm.Create(Application);
- try
- const Files = TStringList.Create;
- try
- Files.Add(PathExtractName(FMainMemo.Filename));
- for var IncludedFile in FIncludedFiles do
- Files.Add(PathExtractName(IncludedFile.Filename));
- if FPreprocessorOutputMemo.Used then
- Files.Add(MemosTabSet.Tabs[MemoToTabIndex(FPreprocessorOutputMemo)]);
- GotoFileForm.Files := Files;
- if GotoFileForm.ShowModal = mrOK then begin
- end;
- finally
- Files.Free;
- end;
- finally
- GotoFileForm.Free;
- end;
- end;
- procedure TMainForm.EGotoLineClick(Sender: TObject);
- var
- S: String;
- L: Integer;
- begin
- S := IntToStr(FActiveMemo.CaretLine + 1);
- if InputQuery('Go to Line', 'Line number:', S) then begin
- L := StrToIntDef(S, Low(L));
- if L <> Low(L) then
- FActiveMemo.CaretLine := L - 1;
- end;
- end;
- procedure TMainForm.StatusBarClick(Sender: TObject);
- begin
- if MemosTabSet.Visible and FOptions.OpenIncludedFiles and (FHiddenFiles.Count > 0) then begin
- var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
- var X := StatusBar.ScreenToClient(Point).X;
- var W := 0;
- for var I := 0 to StatusBar.Panels.Count-1 do begin
- Inc(W, StatusBar.Panels[I].Width);
- if X < W then begin
- if I = spHiddenFilesCount then
- (MemosTabSet.PopupMenu as TMainFormPopupMenu).Popup(Point.X, Point.Y);
- Break;
- end else if I = spHiddenFilesCount then
- Break;
- end;
- end;
- end;
- procedure TMainForm.StatusBarCanvasDrawPanel(Canvas: TCanvas;
- Panel: TStatusPanel; const Rect: TRect);
- const
- TP_DROPDOWNBUTTONGLYPH = 7;
- TS_NORMAL = 1;
- begin
- case Panel.Index of
- spHiddenFilesCount:
- if MemosTabSet.Visible and FOptions.OpenIncludedFiles and (FHiddenFiles.Count > 0) then begin
- var RText := Rect;
- if FToolbarThemeData <> 0 then begin
- Dec(RText.Right, RText.Bottom - RText.Top);
- var RGlyph := Rect;
- RGlyph.Left := RText.Right; { RGlyph is now a square }
- DrawThemeBackground(FToolbarThemeData, Canvas.Handle, TP_DROPDOWNBUTTONGLYPH, TS_NORMAL, RGlyph, nil);
- end;
- var Color: TColor := FTheme.Colors[tcFore];
- const LStyle = TStyleManager.ActiveStyle;
- if not LStyle.IsSystemStyle then begin
- const Details = LStyle.GetElementDetails(tsPane);
- LStyle.GetElementColor(Details, ecTextColor, Color);
- end;
- Canvas.Font.Color := Color;
- var S := Format('Tabs closed: %d', [FHiddenFiles.Count]);
- Canvas.TextRect(RText, S, [tfCenter]);
- end;
- spCompileIcon:
- if FCompiling then begin
- var BuildImageList := ImagesModule.BuildImageList[FTheme.Dark];
- ImageList_Draw(BuildImageList.Handle, FBuildAnimationFrame, Canvas.Handle,
- Rect.Left + ((Rect.Right - Rect.Left) - BuildImageList.Width) div 2,
- Rect.Top + ((Rect.Bottom - Rect.Top) - BuildImageList.Height) div 2, ILD_NORMAL);
- end;
- spCompileProgress:
- if FCompiling and (FProgressMax > 0) then begin
- var R := Rect;
- InflateRect(R, -2, -2);
- var LStyle := StyleServices(Self);
- if not LStyle.Enabled or LStyle.IsSystemStyle then
- LStyle := nil;
- if LStyle <> nil then begin
- { See Vcl.ComCtrl's TProgressBarStyleHook.Paint, .PaintFrame, and .PaintBar }
- var Details: TThemedElementDetails;
- Details.Element := teProgress;
- if LStyle.HasTransparentParts(Details) then
- LStyle.DrawParentBackground(Handle, Canvas.Handle, Details, False, @R);
- Details := LStyle.GetElementDetails(tpBar);
- LStyle.DrawElement(Canvas.Handle, Details, R);
- InflateRect(R, -1, -1);
- const W = R.Width;
- const Pos = Round(W * (FProgress / FProgressMax));
- var FillR := R;
- FillR.Right := FillR.Left + Pos;
- Details := LStyle.GetElementDetails(tpChunk);
- LStyle.DrawElement(Canvas.Handle, Details, FillR);
- end else if FProgressThemeData = 0 then begin
- { Border }
- Canvas.Pen.Color := clBtnShadow;
- Canvas.Brush.Style := bsClear;
- Canvas.Rectangle(R);
- InflateRect(R, -1, -1);
- { Filled part }
- var SaveRight := R.Right;
- R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left,
- FProgressMax);
- Canvas.Brush.Color := clHighlight;
- Canvas.FillRect(R);
- { Unfilled part }
- R.Left := R.Right;
- R.Right := SaveRight;
- Canvas.Brush.Color := clBtnFace;
- Canvas.FillRect(R);
- end else begin
- DrawThemeBackground(FProgressThemeData, Canvas.Handle,
- PP_BAR, 0, R, nil);
- { PP_FILL drawing on Windows 11 (and probably 10) is bugged: when
- the width of the green bar is less than ~25 pixels, the bar is
- drawn over the left border. The same thing happens with
- TProgressBar, so I don't think the API is being used incorrectly.
- Work around the bug by passing a clipping rectangle that excludes
- the left edge when running on Windows 10/11 only. (I don't know if
- earlier versions need it, or if later versions will fix it.) }
- var CR := R;
- if (Win32MajorVersion = 10) and (Win32MinorVersion = 0) then
- Inc(CR.Left); { does this need to be DPI-scaled? }
- R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left,
- FProgressMax);
- DrawThemeBackground(FProgressThemeData, Canvas.Handle,
- PP_FILL, PBFS_NORMAL, R, @CR);
- end;
- end;
- end;
- end;
- procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar;
- Panel: TStatusPanel; const Rect: TRect);
- begin
- StatusBarCanvasDrawPanel(StatusBar.Canvas, Panel, Rect);
- end;
- procedure TMainForm.InvalidateStatusPanel(const Index: Integer);
- var
- R: TRect;
- begin
- { For some reason, the VCL doesn't offer a method for this... }
- if SendMessage(StatusBar.Handle, SB_GETRECT, Index, LPARAM(@R)) <> 0 then begin
- InflateRect(R, -1, -1);
- InvalidateRect(StatusBar.Handle, @R, True);
- end;
- end;
- procedure TMainForm.UpdateCompileStatusPanels(const AProgress,
- AProgressMax: Cardinal; const ASecondsRemaining: Integer;
- const ABytesCompressedPerSecond: Cardinal);
- begin
- var CurTick := GetTickCount;
- var LastTick := FLastAnimationTick;
- FLastAnimationTick := CurTick;
- { Icon and text panels - updated every 500ms }
- if CurTick div 500 <> LastTick div 500 then begin
- InvalidateStatusPanel(spCompileIcon);
- FBuildAnimationFrame := (FBuildAnimationFrame + 1) mod 4;
- if ASecondsRemaining >= 0 then
- StatusBar.Panels[spExtraStatus].Text := Format(
- ' Estimated time remaining: %.2d%s%.2d%s%.2d Average KB/sec: %.0n',
- [(ASecondsRemaining div 60) div 60, FormatSettings.TimeSeparator,
- (ASecondsRemaining div 60) mod 60, FormatSettings.TimeSeparator,
- ASecondsRemaining mod 60, ABytesCompressedPerSecond / 1024])
- else
- StatusBar.Panels[spExtraStatus].Text := '';
- end;
- { Progress panel and taskbar progress bar - updated every 100ms }
- if (CurTick div 100 <> LastTick div 100) and
- ((FProgress <> AProgress) or (FProgressMax <> AProgressMax)) then begin
- FProgress := AProgress;
- FProgressMax := AProgressMax;
- InvalidateStatusPanel(spCompileProgress);
- { The taskbar progress updates are slow (on Windows 11). Limiting the
- range to 64 instead of 1024 improved compression KB/sec by about 4%
- (9000 to 9400) when the rate limit above is disabled. }
- var NewValue: Cardinal := 1; { must be at least 1 for progress bar to show }
- if AProgressMax > 0 then begin
- { Not using MulDiv here to avoid rounding up }
- NewValue := (AProgress * 64) div AProgressMax;
- if NewValue = 0 then
- NewValue := 1;
- end;
- { Don't call the function if the value hasn't changed, just in case there's
- a performance penalty. (There doesn't appear to be on Windows 11.) }
- if FTaskbarProgressValue <> NewValue then begin
- FTaskbarProgressValue := NewValue;
- SetAppTaskbarProgressValue(NewValue, 64);
- end;
- end;
- end;
- procedure TMainForm.WMSettingChange(var Message: TMessage);
- begin
- inherited;
- if (FTheme.Typ <> ttClassic) and IsWindows10 and (Message.LParam <> 0) and (StrIComp(PChar(Message.LParam), 'ImmersiveColorSet') = 0) then begin
- FOptions.ThemeType := GetDefaultThemeType;
- UpdateTheme;
- end;
- for var Memo in FMemos do
- Memo.SettingChange(Message);
- end;
- procedure TMainForm.WMThemeChanged(var Message: TMessage);
- begin
- { Don't Run to Cursor into this function, it will interrupt up the theme change }
- UpdateThemeData(True);
- inherited;
- end;
- procedure TMainForm.WMUAHDrawMenu(var Message: TMessage);
- begin
- if FTheme.Dark then
- UAHDrawMenu(PUAHMenu(Message.lParam))
- else
- inherited;
- end;
- procedure TMainForm.WMUAHDrawMenuItem(var Message: TMessage);
- begin
- if FTheme.Dark then
- UAHDrawMenuItem(PUAHDrawMenuItem(Message.lParam))
- else
- inherited;
- end;
- procedure TMainForm.WMNCActivate(var Message: TMessage);
- begin
- inherited;
- UAHDrawMenuBottomLine;
- end;
- procedure TMainForm.WMNCPaint(var Message: TMessage);
- begin
- inherited;
- UAHDrawMenuBottomLine;
- end;
- procedure TMainForm.RTargetClick(Sender: TObject);
- var
- NewTarget: TDebugTarget;
- begin
- if (Sender = RTargetSetup) or (Sender = TargetSetupButton) then
- NewTarget := dtSetup
- else
- NewTarget := dtUninstall;
- if (FDebugTarget <> NewTarget) and (not FDebugging or AskToDetachDebugger) then
- FDebugTarget := NewTarget;
- { Update always even if the user decided not to switch so the states are restored }
- UpdateTargetMenu;
- end;
- procedure TMainForm.AppOnActivate(Sender: TObject);
- const
- ReloadMessages: array[Boolean] of String = (
- 'The %s file has been modified outside of the source editor.' + SNewLine2 +
- 'Do you want to reload the file?',
- 'The %s file has been modified outside of the source editor. Changes have ' +
- 'also been made in the source editor.' + SNewLine2 + 'Do you want to ' +
- 'reload the file and lose the changes made in the source editor?');
- var
- Memo: TIDEScintFileEdit;
- NewTime: TFileTime;
- Changed: Boolean;
- begin
- for Memo in FFileMemos do begin
- if (Memo.Filename = '') or not Memo.Used then
- Continue;
- { See if the file has been modified outside the editor }
- Changed := False;
- if GetLastWriteTimeOfFile(Memo.Filename, @NewTime) then begin
- if CompareFileTime(Memo.FileLastWriteTime, NewTime) <> 0 then begin
- Memo.FileLastWriteTime := NewTime;
- Changed := True;
- end;
- end;
- { If it has been, offer to reload it }
- if Changed then begin
- if IsWindowEnabled(Handle) then begin
- if (not Memo.Modified and FOptions.Autoreload) or
- (MsgBox(Format(ReloadMessages[Memo.Modified], [Memo.Filename]),
- SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES) then
- if ConfirmCloseFile(False) then begin
- OpenFile(Memo, Memo.Filename, False, FOptions.UndoAfterReload);
- if Memo = FMainMemo then
- Break; { Reloading the main script will also reload all include files }
- end;
- end
- else begin
- { When a modal dialog is up, don't offer to reload the file. Probably
- not a good idea since the dialog might be manipulating the file. }
- MsgBox('The ' + Memo.Filename + ' file has been modified outside ' +
- 'of the source editor. You might want to reload it.',
- SCompilerFormCaption, mbInformation, MB_OK);
- end;
- end;
- end;
- end;
- procedure TMainForm.CompilerOutputListDrawItem(Control: TWinControl;
- Index: Integer; Rect: TRect; State: TOwnerDrawState);
- const
- ThemeColors: array [TStatusMessageKind] of TThemeColor = (tcGreen, tcFore, tcOrange, tcRed);
- var
- Canvas: TCanvas;
- S: String;
- StatusMessageKind: TStatusMessageKind;
- begin
- Canvas := CompilerOutputList.Canvas;
- S := CompilerOutputList.Items[Index];
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- if FOptions.ColorizeCompilerOutput and not (odSelected in State) then begin
- StatusMessageKind := TStatusMessageKind(CompilerOutputList.Items.Objects[Index]);
- Canvas.Font.Color := FTheme.Colors[ThemeColors[StatusMessageKind]];
- end;
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end;
- procedure TMainForm.DebugOutputListDrawItem(Control: TWinControl;
- Index: Integer; Rect: TRect; State: TOwnerDrawState);
- var
- Canvas: TCanvas;
- S: String;
- begin
- Canvas := DebugOutputList.Canvas;
- S := DebugOutputList.Items[Index];
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- if (S <> '') and (S[1] = #9) then
- Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 2, Maxint))
- else begin
- if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin
- { Draw lines that begin with '-- ' (like '-- File entry --') in bold }
- Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
- Canvas.Font.Style := [fsBold];
- Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 18, Maxint));
- end else
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end;
- end;
- procedure TMainForm.DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- var
- Canvas: TCanvas;
- S: String;
- begin
- Canvas := DebugCallStackList.Canvas;
- S := DebugCallStackList.Items[Index];
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end;
- procedure TMainForm.FindResultsListDblClick(Sender: TObject);
- var
- FindResult: TFindResult;
- Memo: TIDEScintFileEdit;
- I: Integer;
- begin
- I := FindResultsList.ItemIndex;
- if I <> -1 then begin
- FindResult := FindResultsList.Items.Objects[I] as TFindResult;
- if FindResult <> nil then begin
- for Memo in FFileMemos do begin
- if Memo.Used and (PathCompare(Memo.Filename, FindResult.Filename) = 0) then begin
- MoveCaretAndActivateMemo(Memo, FindResult.Line, True);
- Memo.SelectAndEnsureVisible(FindResult.Range);
- ActiveControl := Memo;
- Exit;
- end;
- end;
- MsgBox('File not opened.', SCompilerFormCaption, mbError, MB_OK);
- end;
- end;
- end;
- procedure TMainForm.FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
- State: TOwnerDrawState);
- var
- Canvas: TCanvas;
- S, S2: String;
- FindResult: TFindResult;
- StartI, EndI: Integer;
- SaveColor: TColor;
- begin
- Canvas := FindResultsList.Canvas;
- S := FindResultsList.Items[Index];
- FindResult := FindResultsList.Items.Objects[Index] as TFindResult;
- Canvas.FillRect(Rect);
- Inc(Rect.Left, 2);
- if FindResult = nil then begin
- Canvas.Font.Style := [fsBold];
- Canvas.TextOut(Rect.Left, Rect.Top, S);
- end else if not (odSelected in State) then begin
- StartI := FindResult.Range.StartPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
- EndI := FindResult.Range.EndPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
- if StartI > 1 then begin
- Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, StartI-1));
- Rect.Left := Canvas.PenPos.X;
- end;
- SaveColor := Canvas.Brush.Color;
- if FTheme.Dark then
- Canvas.Brush.Color := FTheme.Colors[tcRed]
- else
- Canvas.Brush.Color := FTheme.Colors[tcSelBack];
- S2 := Copy(S, StartI, EndI-StartI);
- Rect.Right := Rect.Left + Canvas.TextWidth(S2);
- Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2); { TextRect instead of TextOut to avoid a margin around the text }
- if EndI <= Length(S) then begin
- Canvas.Brush.Color := SaveColor;
- S2 := Copy(S, EndI, MaxInt);
- Rect.Left := Rect.Right;
- Rect.Right := Rect.Left + Canvas.TextWidth(S2);
- Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2);
- end;
- end else
- Canvas.TextOut(Rect.Left, Rect.Top, S)
- end;
- procedure TMainForm.OutputTabSetClick(Sender: TObject);
- begin
- case OutputTabSet.TabIndex of
- tiCompilerOutput:
- begin
- CompilerOutputList.BringToFront;
- CompilerOutputList.Visible := True;
- DebugOutputList.Visible := False;
- DebugCallStackList.Visible := False;
- FindResultsList.Visible := False;
- end;
- tiDebugOutput:
- begin
- DebugOutputList.BringToFront;
- DebugOutputList.Visible := True;
- CompilerOutputList.Visible := False;
- DebugCallStackList.Visible := False;
- FindResultsList.Visible := False;
- end;
- tiDebugCallStack:
- begin
- DebugCallStackList.BringToFront;
- DebugCallStackList.Visible := True;
- CompilerOutputList.Visible := False;
- DebugOutputList.Visible := False;
- FindResultsList.Visible := False;
- end;
- tiFindResults:
- begin
- FindResultsList.BringToFront;
- FindResultsList.Visible := True;
- CompilerOutputList.Visible := False;
- DebugOutputList.Visible := False;
- DebugCallStackList.Visible := False;
- end;
- end;
- end;
- procedure TMainForm.ToggleBreakPoint(Line: Integer);
- var
- Memo: TIDEScintFileEdit;
- I: Integer;
- begin
- Memo := FActiveMemo as TIDEScintFileEdit;
- I := Memo.BreakPoints.IndexOf(Line);
- if I = -1 then
- Memo.BreakPoints.Add(Line)
- else
- Memo.BreakPoints.Delete(I);
- UpdateLineMarkers(Memo, Line);
- BuildAndSaveBreakPointLines(Memo);
- end;
- procedure TMainForm.MemoMarginClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- begin
- if (MarginNumber = 1) and RToggleBreakPoint.Enabled then
- ToggleBreakPoint(Line);
- end;
- procedure TMainForm.MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
- Line: Integer);
- begin
- if MarginNumber = 1 then begin
- var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
- var PopupMenu := TMainFormPopupMenu.Create(Self, BreakPointsPopupMenu);
- try
- PopupMenu.Popup(Point.X, Point.Y);
- finally
- PopupMenu.Free;
- end;
- end;
- end;
- procedure TMainForm.RToggleBreakPointClick(Sender: TObject);
- begin
- ToggleBreakPoint(FActiveMemo.CaretLine);
- end;
- procedure TMainForm.RDeleteBreakPointsClick(Sender: TObject);
- begin
- { Also see AnyMemoHasBreakPoint }
- for var Memo in FFileMemos do begin
- if Memo.Used and (Memo.BreakPoints.Count > 0) then begin
- for var I := Memo.BreakPoints.Count-1 downto 0 do begin
- var Line := Memo.BreakPoints[I];
- Memo.BreakPoints.Delete(I);
- UpdateLineMarkers(Memo, Line);
- end;
- BuildAndSaveBreakPointLines(Memo);
- end;
- end;
- end;
- procedure TMainForm.UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
- var
- NewMarker: Integer;
- begin
- if Line >= AMemo.Lines.Count then
- Exit;
- var StepLine := AMemo.StepLine = Line;
- NewMarker := -1;
- if AMemo.BreakPoints.IndexOf(Line) <> -1 then begin
- if AMemo.LineState = nil then
- NewMarker := mmiBreakpoint
- else if (Line < AMemo.LineStateCount) and (AMemo.LineState[Line] <> lnUnknown) then
- NewMarker := IfThen(StepLine, mmiBreakpointStep, mmiBreakpointGood)
- else
- NewMarker := mmiBreakpointBad;
- end else if StepLine then
- NewMarker := mmiStep
- else begin
- if Line < AMemo.LineStateCount then begin
- case AMemo.LineState[Line] of
- lnHasEntry: NewMarker := mmiHasEntry;
- lnEntryProcessed: NewMarker := mmiEntryProcessed;
- end;
- end;
- end;
- { Delete all markers on the line. To flush out any possible duplicates,
- even the markers we'll be adding next are deleted. }
- if AMemo.GetMarkers(Line) <> [] then
- AMemo.DeleteAllMarkersOnLine(Line);
- if NewMarker <> -1 then
- AMemo.AddMarker(Line, NewMarker);
- if StepLine then
- AMemo.AddMarker(Line, mlmStep)
- else if AMemo.ErrorLine = Line then
- AMemo.AddMarker(Line, mlmError)
- else if NewMarker = mmiBreakpointBad then
- AMemo.AddMarker(Line, mlmBreakpointBad);
- end;
- procedure TMainForm.UpdateLinkLabelLinkClick(Sender: TObject;
- const Link: string; LinkType: TSysLinkType);
- begin
- if LinkType <> sltID then
- Exit;
- if Link = 'fexit' then
- FExit.Click
- else if Link = 'hpurchase' then
- HPurchase.Click
- else if Link = 'hunregister' then
- HUnregister.Click
- else if Link = 'hwhatsnew' then
- HWhatsNew.Click
- else if Link = 'toptions-vscode' then begin
- TOptionsForm.DropDownMemoKeyMappingComboBoxOnNextShow := True;
- TOptions.Click
- end;
- end;
- procedure TMainForm.UpdatePanelCloseBitBtnClick(Sender: TObject);
- begin
- var MessageToHideIndex := UpdateLinkLabel.Tag;
- var Ini := TConfigIniFile.Create;
- try
- Ini.WriteInteger('UpdatePanel', FUpdatePanelMessages[MessageToHideIndex].ConfigIdent, FUpdatePanelMessages[MessageToHideIndex].ConfigValue);
- finally
- Ini.Free;
- end;
- FUpdatePanelMessages.Delete(MessageToHideIndex);
- UpdateUpdatePanel;
- end;
- procedure TMainForm.UpdatePanelDonateBitBtnClick(Sender: TObject);
- begin
- FDonateImageMenuItem.Click;
- end;
- procedure TMainForm.UpdatePanelCloseBitBtnPaint(Sender: TObject; Canvas: TCanvas; var ARect: TRect);
- const
- MENU_SYSTEMCLOSE = 17;
- MSYSC_NORMAL = 1;
- begin
- var R := ARect;
- if FMenuThemeData <> 0 then begin
- var Offset := MulDiv(2, CurrentPPI, 96);
- Inc(R.Left, Offset);
- DrawThemeBackground(FMenuThemeData, Canvas.Handle, MENU_SYSTEMCLOSE, MSYSC_NORMAL, R, nil);
- end else begin
- InflateRect(R, -MulDiv(6, CurrentPPI, 96), -MulDiv(6, CurrentPPI, 96));
- Canvas.Pen.Color := Canvas.Font.Color;
- Canvas.MoveTo(R.Left, R.Top);
- Canvas.LineTo(R.Right, R.Bottom);
- Canvas.MoveTo(R.Left, R.Bottom-1);
- Canvas.LineTo(R.Right, R.Top-1);
- end;
- end;
- procedure TMainForm.UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
- begin
- for var Line := 0 to AMemo.Lines.Count-1 do
- UpdateLineMarkers(AMemo, Line);
- end;
- procedure TMainForm.UpdateAllMemosLineMarkers;
- begin
- for var Memo in FFileMemos do
- if Memo.Used then
- UpdateAllMemoLineMarkers(Memo);
- end;
- procedure TMainForm.UpdateBevel1Visibility;
- begin
- { Bevel1 is the line between the toolbar and memos when there's nothing in
- between and the color of the toolbar and memo margins is the same }
- Bevel1.Visible := (ToolBarPanel.Color = FTheme.Colors[tcMarginBack]) and
- not UpdatePanel.Visible and not MemosTabSet.Visible;
- end;
- initialization
- Application.OnGetActiveFormHandle := TMainForm.AppOnGetActiveFormHandle;
- InitThemeLibrary;
- InitHtmlHelpLibrary;
- { For ClearType support, try to make the default font Microsoft Sans Serif }
- if DefFontData.Name = 'MS Sans Serif' then
- DefFontData.Name := AnsiString(GetPreferredUIFont);
- CoInitialize(nil);
- finalization
- CoUninitialize();
- end.
|