IDE.MainForm.pas 306 KB

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