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