views.pas 340 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626
  1. {********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
  2. { }
  3. { System independent GRAPHICAL clone of VIEWS.PAS }
  4. { }
  5. { Interface Copyright (c) 1992 Borland International }
  6. { }
  7. { Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer }
  8. { [email protected] - primary e-mail address }
  9. { [email protected] - backup e-mail address }
  10. { }
  11. {****************[ THIS CODE IS FREEWARE ]*****************}
  12. { }
  13. { This sourcecode is released for the purpose to }
  14. { promote the pascal language on all platforms. You may }
  15. { redistribute it and/or modify with the following }
  16. { DISCLAIMER. }
  17. { }
  18. { This SOURCE CODE is distributed "AS IS" WITHOUT }
  19. { WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR }
  20. { ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
  21. { }
  22. {*****************[ SUPPORTED PLATFORMS ]******************}
  23. { 16 and 32 Bit compilers }
  24. { DOS - Turbo Pascal 7.0 + (16 Bit) }
  25. { DPMI - Turbo Pascal 7.0 + (16 Bit) }
  26. { - FPC 0.9912+ (GO32V2) (32 Bit) }
  27. { WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
  28. { - Delphi 1.0+ (16 Bit) }
  29. { WIN95/NT - Delphi 2.0+ (32 Bit) }
  30. { - Virtual Pascal 2.0+ (32 Bit) }
  31. { - Speedsoft Sybil 2.0+ (32 Bit) }
  32. { - FPC 0.9912+ (32 Bit) }
  33. { OS2 - Virtual Pascal 1.0+ (32 Bit) }
  34. { }
  35. {******************[ REVISION HISTORY ]********************}
  36. { Version Date Fix }
  37. { ------- --------- --------------------------------- }
  38. { 1.00 10 Nov 96 First multi platform release }
  39. { 1.10 29 Aug 97 Platform.inc sort added. }
  40. { 1.20 12 Sep 97 FPK pascal 0.92 conversion added. }
  41. { 1.30 10 Jun 98 Virtual pascal 2.0 code added. }
  42. { 1.40 10 Jul 99 Sybil 2.0 code added }
  43. { 1.41 03 Nov 99 FPC Windows support added. }
  44. { 1.50 26 Nov 99 Graphics stuff moved to GFVGraph }
  45. {**********************************************************}
  46. UNIT Views;
  47. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  48. INTERFACE
  49. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  50. {====Include file to sort compiler platform out =====================}
  51. {$I Platform.inc}
  52. {====================================================================}
  53. {==== Compiler directives ===========================================}
  54. {$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
  55. {$F+} { Force far calls - Used because of the FirstThat, ForNext ... }
  56. {$A+} { Word Align Data }
  57. {$B-} { Allow short circuit boolean evaluations }
  58. {$O+} { This unit may be overlaid }
  59. {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
  60. {$P-} { Normal string variables }
  61. {$N-} { No 80x87 code generation }
  62. {$E+} { Emulation is on }
  63. {$ENDIF}
  64. {$X+} { Extended syntax is ok }
  65. {$R-} { Disable range checking }
  66. {$S-} { Disable Stack Checking }
  67. {$I-} { Disable IO Checking }
  68. {$Q-} { Disable Overflow Checking }
  69. {$V-} { Turn off strict VAR strings }
  70. {====================================================================}
  71. USES
  72. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  73. {$IFNDEF PPC_SPEED} { NON SPEEDSOFT SYBIL2+ }
  74. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  75. Windows, { Standard unit }
  76. {$ELSE} { OTHER COMPILERS }
  77. WinTypes, WinProcs, { Stardard units }
  78. {$ENDIF}
  79. {$IFDEF PPC_BP} Win31, {$ENDIF} { Standard 3.1 unit }
  80. {$IFDEF PPC_DELPHI} Messages, {$ENDIF} { Delphi3+ unit }
  81. {$ELSE} { SPEEDSOFT SYBIL2+ }
  82. WinBase, WinDef, WinUser, WinGDI, { Standard unit }
  83. {$ENDIF}
  84. {$ENDIF}
  85. {$IFDEF OS_OS2} { OS2 CODE }
  86. OS2Def, OS2Base, OS2PMAPI, { Standard units }
  87. {$ENDIF}
  88. Common, GFVGraph, Objects, Drivers; { GFV standard units }
  89. {***************************************************************************}
  90. { PUBLIC CONSTANTS }
  91. {***************************************************************************}
  92. {---------------------------------------------------------------------------}
  93. { TView STATE MASKS }
  94. {---------------------------------------------------------------------------}
  95. CONST
  96. sfVisible = $0001; { View visible mask }
  97. sfCursorVis = $0002; { Cursor visible }
  98. sfCursorIns = $0004; { Cursor insert mode }
  99. sfShadow = $0008; { View has shadow }
  100. sfActive = $0010; { View is active }
  101. sfSelected = $0020; { View is selected }
  102. sfFocused = $0040; { View is focused }
  103. sfDragging = $0080; { View is dragging }
  104. sfDisabled = $0100; { View is disabled }
  105. sfModal = $0200; { View is modal }
  106. sfDefault = $0400; { View is default }
  107. sfExposed = $0800; { View is exposed }
  108. sfIconised = $1000; { View is iconised }
  109. {---------------------------------------------------------------------------}
  110. { TView OPTION MASKS }
  111. {---------------------------------------------------------------------------}
  112. CONST
  113. ofSelectable = $0001; { View selectable }
  114. ofTopSelect = $0002; { Top selectable }
  115. ofFirstClick = $0004; { First click react }
  116. ofFramed = $0008; { View is framed }
  117. ofPreProcess = $0010; { Pre processes }
  118. ofPostProcess = $0020; { Post processes }
  119. ofBuffered = $0040; { View is buffered }
  120. ofTileable = $0080; { View is tileable }
  121. ofCenterX = $0100; { View centred on x }
  122. ofCenterY = $0200; { View centred on y }
  123. ofCentered = $0300; { View x,y centred }
  124. ofValidate = $0400; { View validates }
  125. ofVersion = $3000; { View TV version }
  126. ofVersion10 = $0000; { TV version 1 view }
  127. ofVersion20 = $1000; { TV version 2 view }
  128. ofGFVModeView = $4000; { View is in GFV mode }
  129. {---------------------------------------------------------------------------}
  130. { TView GROW MODE MASKS }
  131. {---------------------------------------------------------------------------}
  132. CONST
  133. gfGrowLoX = $01; { Left side grow }
  134. gfGrowLoY = $02; { Top side grow }
  135. gfGrowHiX = $04; { Right side grow }
  136. gfGrowHiY = $08; { Bottom side grow }
  137. gfGrowAll = $0F; { Grow on all sides }
  138. gfGrowRel = $10; { Grow relative }
  139. {---------------------------------------------------------------------------}
  140. { TView DRAG MODE MASKS }
  141. {---------------------------------------------------------------------------}
  142. CONST
  143. dmDragMove = $01; { Move view }
  144. dmDragGrow = $02; { Grow view }
  145. dmLimitLoX = $10; { Limit left side }
  146. dmLimitLoY = $20; { Limit top side }
  147. dmLimitHiX = $40; { Limit right side }
  148. dmLimitHiY = $80; { Limit bottom side }
  149. dmLimitAll = $F0; { Limit all sides }
  150. {---------------------------------------------------------------------------}
  151. { >> NEW << TView OPTION MASKS }
  152. {---------------------------------------------------------------------------}
  153. CONST
  154. goThickFramed = $0001; { Thick framed mask }
  155. goDrawFocus = $0002; { Draw focus mask }
  156. goTitled = $0004; { Draw titled mask }
  157. goTabSelect = $0008; { Tab selectable }
  158. goEveryKey = $0020; { Report every key }
  159. goEndModal = $0040; { End modal }
  160. goGraphView = $1000; { Raw graphic view }
  161. goGraphical = $2000; { Graphical view }
  162. goNativeClass = $4000; { Native class window }
  163. goNoDrawView = $8000; { View does not draw }
  164. {---------------------------------------------------------------------------}
  165. { >> NEW << TAB OPTION MASKS }
  166. {---------------------------------------------------------------------------}
  167. CONST
  168. tmTab = $01; { Tab move mask }
  169. tmShiftTab = $02; { Shift+tab move mask }
  170. tmEnter = $04; { Enter move mask }
  171. tmLeft = $08; { Left arrow move mask }
  172. tmRight = $10; { Right arrow move mask }
  173. tmUp = $20; { Up arrow move mask }
  174. tmDown = $40; { Down arrow move mask }
  175. {---------------------------------------------------------------------------}
  176. { >> NEW << VIEW DRAW MASKS }
  177. {---------------------------------------------------------------------------}
  178. CONST
  179. vdBackGnd = $01; { Draw backgound }
  180. vdInner = $02; { Draw inner detail }
  181. vdCursor = $04; { Draw cursor }
  182. vdBorder = $08; { Draw view border }
  183. vdFocus = $10; { Draw focus state }
  184. vdNoChild = $20; { Draw no children }
  185. {---------------------------------------------------------------------------}
  186. { TView HELP CONTEXTS }
  187. {---------------------------------------------------------------------------}
  188. CONST
  189. hcNoContext = 0; { No view context }
  190. hcDragging = 1; { No drag context }
  191. {---------------------------------------------------------------------------}
  192. { TWindow FLAG MASKS }
  193. {---------------------------------------------------------------------------}
  194. CONST
  195. wfMove = $01; { Window can move }
  196. wfGrow = $02; { Window can grow }
  197. wfClose = $04; { Window can close }
  198. wfZoom = $08; { Window can zoom }
  199. {---------------------------------------------------------------------------}
  200. { TWindow PALETTES }
  201. {---------------------------------------------------------------------------}
  202. CONST
  203. wpBlueWindow = 0; { Blue palette }
  204. wpCyanWindow = 1; { Cyan palette }
  205. wpGrayWindow = 2; { Gray palette }
  206. {---------------------------------------------------------------------------}
  207. { COLOUR PALETTES }
  208. {---------------------------------------------------------------------------}
  209. CONST
  210. CFrame = #1#1#2#2#3; { Frame palette }
  211. CScrollBar = #4#5#5; { Scrollbar palette }
  212. CScroller = #6#7; { Scroller palette }
  213. CListViewer = #26#26#27#28#29; { Listviewer palette }
  214. CBlueWindow = #8#9#10#11#12#13#14#15; { Blue window palette }
  215. CCyanWindow = #16#17#18#19#20#21#22#23; { Cyan window palette }
  216. CGrayWindow = #24#25#26#27#28#29#30#31; { Grey window palette }
  217. {---------------------------------------------------------------------------}
  218. { TScrollBar PART CODES }
  219. {---------------------------------------------------------------------------}
  220. CONST
  221. sbLeftArrow = 0; { Left arrow part }
  222. sbRightArrow = 1; { Right arrow part }
  223. sbPageLeft = 2; { Page left part }
  224. sbPageRight = 3; { Page right part }
  225. sbUpArrow = 4; { Up arrow part }
  226. sbDownArrow = 5; { Down arrow part }
  227. sbPageUp = 6; { Page up part }
  228. sbPageDown = 7; { Page down part }
  229. sbIndicator = 8; { Indicator part }
  230. {---------------------------------------------------------------------------}
  231. { TScrollBar OPTIONS FOR TWindow.StandardScrollBar }
  232. {---------------------------------------------------------------------------}
  233. CONST
  234. sbHorizontal = $0000; { Horz scrollbar }
  235. sbVertical = $0001; { Vert scrollbar }
  236. sbHandleKeyboard = $0002; { Handle keyboard }
  237. {---------------------------------------------------------------------------}
  238. { STANDARD COMMAND CODES }
  239. {---------------------------------------------------------------------------}
  240. CONST
  241. cmValid = 0; { Valid command }
  242. cmQuit = 1; { Quit command }
  243. cmError = 2; { Error command }
  244. cmMenu = 3; { Menu command }
  245. cmClose = 4; { Close command }
  246. cmZoom = 5; { Zoom command }
  247. cmResize = 6; { Resize command }
  248. cmNext = 7; { Next view command }
  249. cmPrev = 8; { Prev view command }
  250. cmHelp = 9; { Help command }
  251. cmOK = 10; { Okay command }
  252. cmCancel = 11; { Cancel command }
  253. cmYes = 12; { Yes command }
  254. cmNo = 13; { No command }
  255. cmDefault = 14; { Default command }
  256. cmCut = 20; { Clipboard cut cmd }
  257. cmCopy = 21; { Clipboard copy cmd }
  258. cmPaste = 22; { Clipboard paste cmd }
  259. cmUndo = 23; { Clipboard undo cmd }
  260. cmClear = 24; { Clipboard clear cmd }
  261. cmTile = 25; { Tile subviews cmd }
  262. cmCascade = 26; { Cascade subviews cmd }
  263. cmReceivedFocus = 50; { Received focus }
  264. cmReleasedFocus = 51; { Released focus }
  265. cmCommandSetChanged = 52; { Commands changed }
  266. cmScrollBarChanged = 53; { Scrollbar changed }
  267. cmScrollBarClicked = 54; { Scrollbar clicked on }
  268. cmSelectWindowNum = 55; { Select window }
  269. cmListItemSelected = 56; { Listview item select }
  270. cmNotify = 27;
  271. cmIdCommunicate = 28; { Communicate via id }
  272. cmIdSelect = 29; { Select via id }
  273. {---------------------------------------------------------------------------}
  274. { TWindow NUMBER CONSTANTS }
  275. {---------------------------------------------------------------------------}
  276. CONST
  277. wnNoNumber = 0; { Window has no num }
  278. MaxViewWidth = 132; { Max view width }
  279. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  280. {$IFDEF BIT_16} { WINDOWS 16 BIT CODE }
  281. {---------------------------------------------------------------------------}
  282. { WIN16 LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
  283. {---------------------------------------------------------------------------}
  284. CONST
  285. ViewSeg = 'TVWINSEG'+#0; { View segment label }
  286. ViewOfs = 'TVWINOFS'+#0; { View offset label }
  287. {$ENDIF}
  288. {$IFDEF BIT_32} { WINDOWS 32 BIT CODE }
  289. {---------------------------------------------------------------------------}
  290. { WIN32/NT LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
  291. {---------------------------------------------------------------------------}
  292. CONST
  293. ViewPtr = 'TVWINPTR'+#0; { View ptr label }
  294. {$ENDIF}
  295. {$ENDIF}
  296. {***************************************************************************}
  297. { PUBLIC TYPE DEFINITIONS }
  298. {***************************************************************************}
  299. {---------------------------------------------------------------------------}
  300. { TWindow Title string }
  301. {---------------------------------------------------------------------------}
  302. TYPE
  303. TTitleStr = String[80]; { Window title string }
  304. {---------------------------------------------------------------------------}
  305. { COMMAND SET RECORD }
  306. {---------------------------------------------------------------------------}
  307. TYPE
  308. TCommandSet = SET OF Byte; { Command set record }
  309. PCommandSet = ^TCommandSet; { Ptr to command set }
  310. {---------------------------------------------------------------------------}
  311. { PALETTE RECORD }
  312. {---------------------------------------------------------------------------}
  313. TYPE
  314. TPalette = String; { Palette record }
  315. PPalette = ^TPalette; { Pointer to palette }
  316. {---------------------------------------------------------------------------}
  317. { TDrawBuffer RECORD }
  318. {---------------------------------------------------------------------------}
  319. TYPE
  320. TDrawBuffer = Array [0..MaxViewWidth - 1] Of Word; { Draw buffer record }
  321. PDrawBuffer = ^TDrawBuffer; { Ptr to draw buffer }
  322. {---------------------------------------------------------------------------}
  323. { TVideoBuffer RECORD }
  324. {---------------------------------------------------------------------------}
  325. TYPE
  326. TVideoBuf = ARRAY [0..3999] of Word; { Video buffer }
  327. PVideoBuf = ^TVideoBuf; { Pointer to buffer }
  328. {---------------------------------------------------------------------------}
  329. { TComplexArea RECORD }
  330. {---------------------------------------------------------------------------}
  331. TYPE
  332. PComplexArea = ^TComplexArea; { Complex area }
  333. TComplexArea = PACKED RECORD
  334. X1, Y1 : Integer; { Top left corner }
  335. X2, Y2 : Integer; { Lower right corner }
  336. NextArea: PComplexArea; { Next area pointer }
  337. END;
  338. {***************************************************************************}
  339. { PUBLIC OBJECT DEFINITIONS }
  340. {***************************************************************************}
  341. TYPE
  342. PGroup = ^TGroup; { Pointer to group }
  343. {---------------------------------------------------------------------------}
  344. { TView OBJECT - ANCESTOR VIEW OBJECT }
  345. {---------------------------------------------------------------------------}
  346. PView = ^TView;
  347. TView = OBJECT (TObject)
  348. GrowMode : Byte; { View grow mode }
  349. DragMode : Byte; { View drag mode }
  350. DrawMask : Byte; { Draw masks }
  351. TabMask : Byte; { Tab move masks }
  352. ColourOfs : Integer; { View palette offset }
  353. HelpCtx : Word; { View help context }
  354. State : Word; { View state masks }
  355. Options : Word; { View options masks }
  356. EventMask : Word; { View event masks }
  357. GOptions : Word; { Graphics options }
  358. Origin : TPoint; { View origin }
  359. Size : TPoint; { View size }
  360. Cursor : TPoint; { Cursor position }
  361. RawOrigin : TPoint; { View raw origin }
  362. RawSize : TPoint; { View raw size }
  363. Next : PView; { Next peerview }
  364. Owner : PGroup; { Owner group }
  365. HoldLimit : PComplexArea; { Hold limit values }
  366. {$IFDEF OS_WINDOWS} { WIN/NT DATA ONLY }
  367. ExStyle : LongInt; { Extended style }
  368. Dc : HDc; { Device context }
  369. {$ENDIF}
  370. {$IFDEF OS_OS2} { OS2 DATA ONLY }
  371. lStyle : LongInt; { Style }
  372. Client : HWnd; { Client handle }
  373. Ps : HPs; { Paint structure }
  374. {$ENDIF}
  375. {$IFNDEF OS_DOS} { WIN/NT/OS2 DATA ONLY }
  376. FrameSize : Integer; { Frame size (X) }
  377. CaptSize : Integer; { Caption size (Y) }
  378. HWindow : HWnd; { Window handle }
  379. {$ENDIF}
  380. CONSTRUCTOR Init (Var Bounds: TRect);
  381. CONSTRUCTOR Load (Var S: TStream);
  382. DESTRUCTOR Done; Virtual;
  383. FUNCTION Prev: PView;
  384. FUNCTION Execute: Word; Virtual;
  385. FUNCTION Focus: Boolean;
  386. FUNCTION DataSize: Word; Virtual;
  387. FUNCTION TopView: PView;
  388. FUNCTION PrevView: PView;
  389. FUNCTION NextView: PView;
  390. FUNCTION GetHelpCtx: Word; Virtual;
  391. FUNCTION EventAvail: Boolean;
  392. FUNCTION GetPalette: PPalette; Virtual;
  393. FUNCTION GetColor (Color: Word): Word;
  394. FUNCTION Valid (Command: Word): Boolean; Virtual;
  395. FUNCTION GetState (AState: Word): Boolean;
  396. FUNCTION TextWidth (Txt: String): Integer;
  397. FUNCTION MouseInView (Point: TPoint): Boolean;
  398. FUNCTION CommandEnabled (Command: Word): Boolean;
  399. FUNCTION OverLapsArea (X1, Y1, X2, Y2: Integer): Boolean;
  400. FUNCTION MouseEvent (Var Event: TEvent; Mask: Word): Boolean;
  401. PROCEDURE Hide;
  402. PROCEDURE Show;
  403. PROCEDURE Draw; Virtual;
  404. PROCEDURE Select;
  405. PROCEDURE Awaken; Virtual;
  406. PROCEDURE DrawView;
  407. PROCEDURE MakeFirst;
  408. PROCEDURE DrawFocus; Virtual;
  409. PROCEDURE DrawCursor; Virtual;
  410. PROCEDURE DrawBorder; Virtual;
  411. PROCEDURE HideCursor;
  412. PROCEDURE ShowCursor;
  413. PROCEDURE BlockCursor;
  414. PROCEDURE NormalCursor;
  415. PROCEDURE FocusFromTop; Virtual;
  416. PROCEDURE SetViewLimits;
  417. PROCEDURE DrawBackGround; Virtual;
  418. PROCEDURE ReleaseViewLimits;
  419. PROCEDURE MoveTo (X, Y: Integer);
  420. PROCEDURE GrowTo (X, Y: Integer);
  421. PROCEDURE SetDrawMask (Mask: Byte);
  422. PROCEDURE EndModal (Command: Word); Virtual;
  423. PROCEDURE SetCursor (X, Y: Integer);
  424. PROCEDURE PutInFrontOf (Target: PView);
  425. PROCEDURE DisplaceBy (Dx, Dy: Integer); Virtual;
  426. PROCEDURE SetCommands (Commands: TCommandSet);
  427. PROCEDURE ReDrawArea (X1, Y1, X2, Y2: Integer);
  428. PROCEDURE EnableCommands (Commands: TCommandSet);
  429. PROCEDURE DisableCommands (Commands: TCommandSet);
  430. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  431. PROCEDURE SetCmdState (Commands: TCommandSet; Enable: Boolean);
  432. PROCEDURE GetData (Var Rec); Virtual;
  433. PROCEDURE SetData (Var Rec); Virtual;
  434. PROCEDURE Store (Var S: TStream);
  435. PROCEDURE Locate (Var Bounds: TRect);
  436. PROCEDURE KeyEvent (Var Event: TEvent);
  437. PROCEDURE GetEvent (Var Event: TEvent); Virtual;
  438. PROCEDURE PutEvent (Var Event: TEvent); Virtual;
  439. PROCEDURE GetExtent (Var Extent: TRect);
  440. PROCEDURE GetBounds (Var Bounds: TRect);
  441. PROCEDURE SetBounds (Var Bounds: TRect);
  442. PROCEDURE GetClipRect (Var Clip: TRect);
  443. PROCEDURE ClearEvent (Var Event: TEvent);
  444. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  445. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  446. PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual;
  447. PROCEDURE GetCommands (Var Commands: TCommandSet);
  448. PROCEDURE GetPeerViewPtr (Var S: TStream; Var P);
  449. PROCEDURE PutPeerViewPtr (Var S: TStream; P: PView);
  450. PROCEDURE CalcBounds (Var Bounds: TRect; Delta: TPoint); Virtual;
  451. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  452. FUNCTION GetClassId: LongInt; Virtual;
  453. FUNCTION GetClassName: String; Virtual;
  454. FUNCTION GetClassText: String; Virtual;
  455. FUNCTION GetClassAttr: LongInt; Virtual;
  456. FUNCTION GetNotifyCmd: LongInt; Virtual;
  457. FUNCTION GetMsgHandler: Pointer; Virtual;
  458. {$ENDIF}
  459. FUNCTION Exposed: Boolean; { This needs help!!!!! }
  460. PROCEDURE GraphLine (X1, Y1, X2, Y2: Integer; Colour: Byte);
  461. PROCEDURE GraphRectangle (X1, Y1, X2, Y2: Integer; Colour: Byte);
  462. PROCEDURE ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
  463. PROCEDURE GraphArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad: Integer;
  464. Colour: Byte);
  465. PROCEDURE FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
  466. Colour: Byte);
  467. PROCEDURE BicolorRectangle (X1, Y1, X2, Y2: Integer; Light, Dark: Byte;
  468. Down: Boolean);
  469. PROCEDURE WriteBuf (X, Y, W, H: Integer; Var Buf);
  470. PROCEDURE WriteLine (X, Y, W, H: Integer; Var Buf);
  471. PROCEDURE MakeLocal (Source: TPoint; Var Dest: TPoint);
  472. PROCEDURE MakeGlobal (Source: TPoint; Var Dest: TPoint);
  473. PROCEDURE WriteStr (X, Y: Integer; Str: String; Color: Byte);
  474. PROCEDURE WriteChar (X, Y: Integer; C: Char; Color: Byte;
  475. Count: Integer);
  476. PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
  477. MinSize, MaxSize: TPoint);
  478. FUNCTION FontWidth: Integer;
  479. FUNCTION Fontheight: Integer;
  480. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  481. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  482. {$ENDIF}
  483. END;
  484. SelectMode = (NormalSelect, EnterSelect, LeaveSelect);
  485. {---------------------------------------------------------------------------}
  486. { TGroup OBJECT - GROUP OBJECT ANCESTOR }
  487. {---------------------------------------------------------------------------}
  488. TGroup = OBJECT (TView)
  489. Phase : (phFocused, phPreProcess, phPostProcess);
  490. EndState: Word; { Modal result }
  491. Current : PView; { Selected subview }
  492. Last : PView; { 1st view inserted }
  493. Buffer : PVideoBuf; { Speed up buffer }
  494. CONSTRUCTOR Init (Var Bounds: TRect);
  495. CONSTRUCTOR Load (Var S: TStream);
  496. DESTRUCTOR Done; Virtual;
  497. FUNCTION First: PView;
  498. FUNCTION Execute: Word; Virtual;
  499. FUNCTION GetHelpCtx: Word; Virtual;
  500. FUNCTION DataSize: Word; Virtual;
  501. FUNCTION ExecView (P: PView): Word; Virtual;
  502. FUNCTION FirstThat (P: Pointer): PView;
  503. FUNCTION Valid (Command: Word): Boolean; Virtual;
  504. FUNCTION FocusNext (Forwards: Boolean): Boolean;
  505. PROCEDURE Draw; Virtual;
  506. PROCEDURE Lock;
  507. PROCEDURE UnLock;
  508. PROCEDURE Awaken; Virtual;
  509. PROCEDURE ReDraw;
  510. PROCEDURE SelectDefaultView;
  511. PROCEDURE Insert (P: PView);
  512. PROCEDURE Delete (P: PView);
  513. PROCEDURE ForEach (P: Pointer); Virtual;
  514. PROCEDURE EndModal (Command: Word); Virtual;
  515. PROCEDURE DisplaceBy (Dx, Dy: Integer); Virtual;
  516. PROCEDURE SelectNext (Forwards: Boolean);
  517. PROCEDURE InsertBefore (P, Target: PView);
  518. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  519. PROCEDURE GetData (Var Rec); Virtual;
  520. PROCEDURE SetData (Var Rec); Virtual;
  521. PROCEDURE Store (Var S: TStream);
  522. PROCEDURE EventError (Var Event: TEvent); Virtual;
  523. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  524. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  525. PROCEDURE GetSubViewPtr (Var S: TStream; Var P);
  526. PROCEDURE PutSubViewPtr (Var S: TStream; P: PView);
  527. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  528. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  529. {$ENDIF}
  530. PRIVATE
  531. LockFlag: Byte;
  532. Clip : TRect;
  533. FUNCTION IndexOf (P: PView): Integer;
  534. FUNCTION FindNext (Forwards: Boolean): PView;
  535. FUNCTION FirstMatch (AState: Word; AOptions: Word): PView;
  536. PROCEDURE ResetCurrent;
  537. PROCEDURE RemoveView (P: PView);
  538. PROCEDURE InsertView (P, Target: PView);
  539. PROCEDURE SetCurrent (P: PView; Mode: SelectMode);
  540. END;
  541. {---------------------------------------------------------------------------}
  542. { TFrame OBJECT - FRAME VIEW OBJECT }
  543. {---------------------------------------------------------------------------}
  544. TYPE
  545. TFrame = OBJECT (TView)
  546. CONSTRUCTOR Init (Var Bounds: TRect);
  547. FUNCTION GetPalette: PPalette; Virtual;
  548. END;
  549. PFrame = ^TFrame;
  550. {---------------------------------------------------------------------------}
  551. { TScrollBar OBJECT - SCROLL BAR OBJECT }
  552. {---------------------------------------------------------------------------}
  553. TYPE
  554. TScrollChars = Array [0..4] of Char;
  555. TScrollBar = OBJECT (TView)
  556. Value : Integer; { Scrollbar value }
  557. Min : Integer; { Scrollbar minimum }
  558. Max : Integer; { Scrollbar maximum }
  559. PgStep: Integer; { One page step }
  560. ArStep: Integer; { One range step }
  561. Id : Integer; { Scrollbar ID }
  562. CONSTRUCTOR Init (Var Bounds: TRect);
  563. CONSTRUCTOR Load (Var S: TStream);
  564. FUNCTION GetPalette: PPalette; Virtual;
  565. FUNCTION ScrollStep (Part: Integer): Integer; Virtual;
  566. PROCEDURE Draw; Virtual;
  567. PROCEDURE ScrollDraw; Virtual;
  568. PROCEDURE DrawBackGround; Virtual;
  569. PROCEDURE SetValue (AValue: Integer);
  570. PROCEDURE SetRange (AMin, AMax: Integer);
  571. PROCEDURE SetStep (APgStep, AArStep: Integer);
  572. PROCEDURE SetParams (AValue, AMin, AMax, APgStep, AArStep: Integer);
  573. PROCEDURE Store (Var S: TStream);
  574. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  575. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  576. FUNCTION GetClassName: String; Virtual;
  577. FUNCTION GetClassAttr: LongInt; Virtual;
  578. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  579. {$ENDIF}
  580. PRIVATE
  581. Chars: TScrollChars; { Scrollbar chars }
  582. FUNCTION GetPos: Integer;
  583. FUNCTION GetSize: Integer;
  584. PROCEDURE DrawPos (Pos: Integer);
  585. PROCEDURE ClearPos (Pos: Integer);
  586. END;
  587. PScrollBar = ^TScrollBar;
  588. {---------------------------------------------------------------------------}
  589. { TScroller OBJECT - SCROLLING VIEW ANCESTOR }
  590. {---------------------------------------------------------------------------}
  591. TYPE
  592. TScroller = OBJECT (TView)
  593. Delta : TPoint;
  594. Limit : TPoint;
  595. HScrollBar: PScrollBar; { Horz scroll bar }
  596. VScrollBar: PScrollBar; { Vert scroll bar }
  597. CONSTRUCTOR Init (Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  598. CONSTRUCTOR Load (Var S: TStream);
  599. FUNCTION GetPalette: PPalette; Virtual;
  600. PROCEDURE ScrollDraw; Virtual;
  601. PROCEDURE SetLimit (X, Y: Integer);
  602. PROCEDURE ScrollTo (X, Y: Integer);
  603. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  604. PROCEDURE Store (Var S: TStream);
  605. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  606. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  607. PRIVATE
  608. DrawFlag: Boolean;
  609. DrawLock: Byte;
  610. PROCEDURE CheckDraw;
  611. END;
  612. PScroller = ^TScroller;
  613. {---------------------------------------------------------------------------}
  614. { TListViewer OBJECT - LIST VIEWER OBJECT }
  615. {---------------------------------------------------------------------------}
  616. TYPE
  617. TListViewer = OBJECT (TView)
  618. NumCols : Integer; { Number of columns }
  619. TopItem : Integer; { Top most item }
  620. Focused : Integer; { Focused item }
  621. Range : Integer; { Range of listview }
  622. HScrollBar: PScrollBar; { Horz scrollbar }
  623. VScrollBar: PScrollBar; { Vert scrollbar }
  624. CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Word; AHScrollBar,
  625. AVScrollBar: PScrollBar);
  626. CONSTRUCTOR Load (Var S: TStream);
  627. FUNCTION GetPalette: PPalette; Virtual;
  628. FUNCTION IsSelected (Item: Integer): Boolean; Virtual;
  629. FUNCTION GetText (Item: Integer; MaxLen: Integer): String; Virtual;
  630. PROCEDURE DrawFocus; Virtual;
  631. PROCEDURE DrawBackGround; Virtual;
  632. PROCEDURE FocusItem (Item: Integer); Virtual;
  633. PROCEDURE SetTopItem (Item: Integer);
  634. PROCEDURE SetRange (ARange: Integer);
  635. PROCEDURE SelectItem (Item: Integer); Virtual;
  636. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  637. PROCEDURE Store (Var S: TStream);
  638. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  639. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  640. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  641. FUNCTION GetNotifyCmd: LongInt; Virtual;
  642. FUNCTION GetClassName: String; Virtual;
  643. FUNCTION GetClassAttr: LongInt; Virtual;
  644. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  645. {$ENDIF}
  646. PRIVATE
  647. PROCEDURE FocusItemNum (Item: Integer); Virtual;
  648. END;
  649. PListViewer = ^TListViewer;
  650. {---------------------------------------------------------------------------}
  651. { TWindow OBJECT - WINDOW OBJECT ANCESTOR }
  652. {---------------------------------------------------------------------------}
  653. TYPE
  654. TWindow = OBJECT (TGroup)
  655. Flags : Byte; { Window flags }
  656. Number : Integer; { Window number }
  657. Palette : Integer; { Window palette }
  658. ZoomRect: TRect; { Zoom rectangle }
  659. Frame : PFrame; { Frame view object }
  660. Title : PString; { Title string }
  661. CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
  662. CONSTRUCTOR Load (Var S: TStream);
  663. DESTRUCTOR Done; Virtual;
  664. FUNCTION GetPalette: PPalette; Virtual;
  665. FUNCTION GetTitle (MaxSize: Integer): TTitleStr; Virtual;
  666. FUNCTION StandardScrollBar (AOptions: Word): PScrollBar;
  667. PROCEDURE Zoom; Virtual;
  668. PROCEDURE Close; Virtual;
  669. PROCEDURE InitFrame; Virtual;
  670. PROCEDURE DrawBorder; Virtual;
  671. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  672. PROCEDURE Store (Var S: TStream);
  673. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  674. PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual;
  675. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  676. FUNCTION GetClassText: String; Virtual;
  677. FUNCTION GetClassAttr: LongInt; Virtual;
  678. {$ENDIF}
  679. END;
  680. PWindow = ^TWindow;
  681. {***************************************************************************}
  682. { INTERFACE ROUTINES }
  683. {***************************************************************************}
  684. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  685. { WINDOW MESSAGE ROUTINES }
  686. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  687. {-Message------------------------------------------------------------
  688. Message sets up an event record and calls Receiver^.HandleEvent to
  689. handle the event. Message returns nil if Receiver is nil, or if
  690. the event is not handled successfully.
  691. 12Sep97 LdB
  692. ---------------------------------------------------------------------}
  693. FUNCTION Message (Receiver: PView; What, Command: Word;
  694. InfoPtr: Pointer): Pointer;
  695. {-NewMessage---------------------------------------------------------
  696. NewMessage sets up an event record including the new fields and calls
  697. Receiver^.HandleEvent to handle the event. Message returns nil if
  698. Receiver is nil, or if the event is not handled successfully.
  699. 19Sep97 LdB
  700. ---------------------------------------------------------------------}
  701. FUNCTION NewMessage (P: PView; What, Command: Word; Id: Integer; Data: Real;
  702. InfoPtr: Pointer): Pointer;
  703. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  704. { VIEW OBJECT REGISTRATION ROUTINES }
  705. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  706. {-RegisterViews------------------------------------------------------
  707. This registers all the view type objects used in this unit.
  708. 11Aug99 LdB
  709. ---------------------------------------------------------------------}
  710. PROCEDURE RegisterViews;
  711. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  712. { NEW VIEW ROUTINES }
  713. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  714. {-CreateIdScrollBar--------------------------------------------------
  715. Creates and scrollbar object of the given size and direction and sets
  716. the scrollbar id number.
  717. 22Sep97 LdB
  718. ---------------------------------------------------------------------}
  719. FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
  720. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  721. { NEW WIN/NT/OS2 VERSION SPECIFIC INTERFACE ROUTINES }
  722. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  723. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  724. {-TvViewMsgHandler---------------------------------------------------
  725. This is the default WIN/NT handler for TView objects. Descendant
  726. objects may need to call back to this handler so it must be provided
  727. on the interface.
  728. 11Aug99 LdB
  729. ---------------------------------------------------------------------}
  730. FUNCTION TvViewMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
  731. lParam: LongInt): LongInt;
  732. {$IFDEF BIT_16} EXPORT; {$ENDIF}
  733. {$IFDEF BIT_32} {$IFDEF PPC_SPEED} CDECL; {$ELSE} STDCALL; {$ENDIF} {$ENDIF}
  734. {$ENDIF}
  735. {$IFDEF OS_OS2} { OS2 CODE }
  736. {-TvViewMsgHandler---------------------------------------------------
  737. This is the default OS2 handler for TView objects. Descendant objects
  738. may need to call back to this handler so it must be provided on the
  739. interface.
  740. 11Aug99 LdB
  741. ---------------------------------------------------------------------}
  742. FUNCTION TvViewMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult;
  743. CDECL; EXPORT;
  744. {$ENDIF}
  745. {***************************************************************************}
  746. { INITIALIZED PUBLIC VARIABLES }
  747. {***************************************************************************}
  748. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  749. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  750. TYPE TColorRef = LongInt; { TColorRef defined }
  751. {$ENDIF}
  752. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  753. TYPE TColorRef = LongInt; { TColorRef defined }
  754. TPaintStruct = PaintStruct;
  755. TWindowPos = WindowPos;
  756. TSize = Size;
  757. TWndClass = WndClass;
  758. {$ENDIF}
  759. {---------------------------------------------------------------------------}
  760. { INITIALIZED WIN/NT VARIABLES }
  761. {---------------------------------------------------------------------------}
  762. CONST
  763. ColRef: Array [0..15] Of TColorRef = { Standard colour refs }
  764. (rgb_Black, rgb_Blue, rgb_Green, rgb_Cyan,
  765. rgb_Red, rgb_Magenta, rgb_Brown, rgb_LightGray,
  766. rgb_DarkGray, rgb_LightBlue, rgb_LightGreen,
  767. rgb_LightCyan, rgb_LightRed, rgb_LightMagenta,
  768. rgb_Yellow, rgb_White);
  769. ColBrush: Array [0..15] Of HBrush =
  770. (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  771. ColPen: Array [0..15] Of HPen =
  772. (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  773. {$ENDIF}
  774. {$IFDEF OS_OS2} { OS2 CODE }
  775. {---------------------------------------------------------------------------}
  776. { INITIALIZED OS2 VARIABLES }
  777. {---------------------------------------------------------------------------}
  778. CONST
  779. ColRef: Array [0..15] Of LongInt =
  780. (clr_Black, clr_DarkBlue, clr_DarkGreen, clr_DarkCyan,
  781. clr_DarkRed, clr_DarkPink, clr_Brown, clr_PaleGray,
  782. clr_DarkGray, clr_Blue, clr_Green, clr_Cyan,
  783. clr_Red, clr_Pink, clr_Yellow, clr_White);
  784. {$ENDIF}
  785. {---------------------------------------------------------------------------}
  786. { INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
  787. {---------------------------------------------------------------------------}
  788. CONST
  789. UseNativeClasses: Boolean = True; { Native class modes }
  790. CommandSetChanged: Boolean = False; { Command change flag }
  791. ShowMarkers: Boolean = False; { Show marker state }
  792. ErrorAttr: Byte = $CF; { Error colours }
  793. PositionalEvents: Word = evMouse; { Positional defined }
  794. FocusedEvents: Word = evKeyboard + evCommand; { Focus defined }
  795. MinWinSize: TPoint = (X: 16; Y: 6); { Minimum window size }
  796. ShadowSize: TPoint = (X: 2; Y: 1); { Shadow sizes }
  797. ShadowAttr: Byte = $08; { Shadow attribute }
  798. { Characters used for drawing selected and default items in }
  799. { monochrome color sets }
  800. SpecialChars: Array [0..5] Of Char = (#175, #174, #26, #27, ' ', ' ');
  801. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  802. { STREAM REGISTRATION RECORDS }
  803. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  804. {---------------------------------------------------------------------------}
  805. { TView STREAM REGISTRATION }
  806. {---------------------------------------------------------------------------}
  807. CONST
  808. RView: TStreamRec = (
  809. ObjType: 1; { Register id = 1 }
  810. {$IFDEF BP_VMTLink}
  811. VmtLink: Ofs(TypeOf(TView)^); { BP style VMT link }
  812. {$ELSE}
  813. VmtLink: TypeOf(TView); { Alt style VMT link }
  814. {$ENDIF}
  815. Load: @TView.Load; { Object load method }
  816. Store: @TView.Store { Object store method }
  817. );
  818. {---------------------------------------------------------------------------}
  819. { TFrame STREAM REGISTRATION }
  820. {---------------------------------------------------------------------------}
  821. CONST
  822. RFrame: TStreamRec = (
  823. ObjType: 2; { Register id = 2 }
  824. {$IFDEF BP_VMTLink}
  825. VmtLink: Ofs(TypeOf(TFrame)^); { BP style VMT link }
  826. {$ELSE}
  827. VmtLink: TypeOf(TFrame); { Alt style VMT link }
  828. {$ENDIF}
  829. Load: @TFrame.Load; { Frame load method }
  830. Store: @TFrame.Store { Frame store method }
  831. );
  832. {---------------------------------------------------------------------------}
  833. { TScrollBar STREAM REGISTRATION }
  834. {---------------------------------------------------------------------------}
  835. CONST
  836. RScrollBar: TStreamRec = (
  837. ObjType: 3; { Register id = 3 }
  838. {$IFDEF BP_VMTLink}
  839. VmtLink: Ofs(TypeOf(TScrollBar)^); { BP style VMT link }
  840. {$ELSE}
  841. VmtLink: TypeOf(TScrollBar); { Alt style VMT link }
  842. {$ENDIF}
  843. Load: @TScrollBar.Load; { Object load method }
  844. Store: @TScrollBar.Store { Object store method }
  845. );
  846. {---------------------------------------------------------------------------}
  847. { TScroller STREAM REGISTRATION }
  848. {---------------------------------------------------------------------------}
  849. CONST
  850. RScroller: TStreamRec = (
  851. ObjType: 4; { Register id = 4 }
  852. {$IFDEF BP_VMTLink}
  853. VmtLink: Ofs(TypeOf(TScroller)^); { BP style VMT link }
  854. {$ELSE}
  855. VmtLink: TypeOf(TScroller); { Alt style VMT link }
  856. {$ENDIF}
  857. Load: @TScroller.Load; { Object load method }
  858. Store: @TScroller.Store { Object store method }
  859. );
  860. {---------------------------------------------------------------------------}
  861. { TListViewer STREAM REGISTRATION }
  862. {---------------------------------------------------------------------------}
  863. CONST
  864. RListViewer: TStreamRec = (
  865. ObjType: 5; { Register id = 5 }
  866. {$IFDEF BP_VMTLink}
  867. VmtLink: Ofs(TypeOf(TListViewer)^); { BP style VMT link }
  868. {$ELSE}
  869. VmtLink: TypeOf(TListViewer); { Alt style VMT link }
  870. {$ENDIF}
  871. Load: @TListViewer.Load; { Object load method }
  872. Store: @TLIstViewer.Store { Object store method }
  873. );
  874. {---------------------------------------------------------------------------}
  875. { TGroup STREAM REGISTRATION }
  876. {---------------------------------------------------------------------------}
  877. CONST
  878. RGroup: TStreamRec = (
  879. ObjType: 6; { Register id = 6 }
  880. {$IFDEF BP_VMTLink}
  881. VmtLink: Ofs(TypeOf(TGroup)^); { BP style VMT link }
  882. {$ELSE}
  883. VmtLink: TypeOf(TGroup); { Alt style VMT link }
  884. {$ENDIF}
  885. Load: @TGroup.Load; { Object load method }
  886. Store: @TGroup.Store { Object store method }
  887. );
  888. {---------------------------------------------------------------------------}
  889. { TWindow STREAM REGISTRATION }
  890. {---------------------------------------------------------------------------}
  891. CONST
  892. RWindow: TStreamRec = (
  893. ObjType: 7; { Register id = 7 }
  894. {$IFDEF BP_VMTLink}
  895. VmtLink: Ofs(TypeOf(TWindow)^); { BP style VMT link }
  896. {$ELSE}
  897. VmtLink: TypeOf(TWindow); { Alt style VMT link }
  898. {$ENDIF}
  899. Load: @TWindow.Load; { Object load method }
  900. Store: @TWindow.Store { Object store method }
  901. );
  902. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  903. IMPLEMENTATION
  904. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  905. {***************************************************************************}
  906. { PRIVATE CONSTANT DEFINITIONS }
  907. {***************************************************************************}
  908. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  909. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  910. CONST WM_Notify = $004E; { Value was left out }
  911. {$ENDIF}
  912. {$ENDIF}
  913. {***************************************************************************}
  914. { PRIVATE TYPE DEFINITIONS }
  915. {***************************************************************************}
  916. {---------------------------------------------------------------------------}
  917. { TFixupList DEFINITION }
  918. {---------------------------------------------------------------------------}
  919. TYPE
  920. TFixupList = ARRAY [1..4096] Of Pointer; { Fix up ptr array }
  921. PFixupList = ^TFixupList; { Ptr to fix up list }
  922. {***************************************************************************}
  923. { PRIVATE INITIALIZED VARIABLES }
  924. {***************************************************************************}
  925. {---------------------------------------------------------------------------}
  926. { INITIALIZED DOS/DPMI/WIN/NT/OS2 PRIVATE VARIABLES }
  927. {---------------------------------------------------------------------------}
  928. CONST
  929. TheTopView : PView = Nil; { Top focused view }
  930. LimitsLocked: PView = Nil; { View locking limits }
  931. OwnerGroup : PGroup = Nil; { Used for loading }
  932. FixupList : PFixupList = Nil; { Used for loading }
  933. CurCommandSet: TCommandSet = ([0..255] -
  934. [cmZoom, cmClose, cmResize, cmNext, cmPrev]); { All active but these }
  935. {***************************************************************************}
  936. { PRIVATE INTERNAL ROUTINES }
  937. {***************************************************************************}
  938. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  939. {---------------------------------------------------------------------------}
  940. { TvViewMsgHandler -> Platforms WIN/NT - Updated 09Aug99 LdB }
  941. {---------------------------------------------------------------------------}
  942. FUNCTION TvViewMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
  943. lParam: LongInt): LongInt; {$IFDEF PPC_FPC} STDCALL; {$ENDIF}
  944. VAR Bc: Byte; I: LongInt; W: Word; Event: TEvent; P, Tp: PView;
  945. Q: PScrollBar; Ps: TPaintStruct; Wp: ^TWindowPos;
  946. BEGIN
  947. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  948. PtrRec(P).Seg := GetProp(Wnd, ViewSeg); { Fetch seg property }
  949. PtrRec(P).Ofs := GetProp(Wnd, ViewOfs); { Fetch ofs property }
  950. {$ENDIF}
  951. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  952. LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch view pointer }
  953. {$ENDIF}
  954. If (P <> Nil) Then Begin { Valid view pointer }
  955. TvViewMsgHandler := 0; { Preset return zero }
  956. Event.What := evNothing; { Preset no event }
  957. Case iMessage Of
  958. WM_Close: Begin { CLOSE COMMAND }
  959. If (P^.GetState(sfFocused) = False) Then
  960. P^.FocusFromTop; { Focus if behind }
  961. Event.What := evCommand; { Command event }
  962. Event.Command := cmClose; { Quit command }
  963. Event.InfoPtr := P; { Pointer to view }
  964. End;
  965. WM_LButtonDown: Begin { LEFT MOUSE DOWN }
  966. Event.What := evMouseDown; { Mouse down event }
  967. Event.Double := False; { Not double click }
  968. MouseButtons := MouseButtons OR mbLeftButton;{ Set button mask }
  969. End;
  970. WM_LButtonUp: Begin { LEFT MOUSE UP }
  971. Event.What := evMouseUp; { Mouse up event }
  972. Event.Double := False; { Not double click }
  973. MouseButtons := MouseButtons AND NOT
  974. mbLeftButton; { Clear button mask }
  975. End;
  976. WM_LButtonDBLClk: Begin { LEFT MOUSE DBL CLK }
  977. Event.What := evMouseDown; { Mouse down event }
  978. Event.Double := True; { Double click }
  979. MouseButtons := MouseButtons OR mbLeftButton;{ Set button mask }
  980. End;
  981. WM_RButtonDown: Begin { RIGHT MOUSE DOWN }
  982. Event.What := evMouseDown; { Mouse down event }
  983. Event.Double := False; { Not double click }
  984. MouseButtons := MouseButtons OR
  985. mbRightButton; { Set button mask }
  986. End;
  987. WM_RButtonUp: Begin { RIGHT MOUSE UP }
  988. Event.What := evMouseUp; { Mouse up event }
  989. Event.Double := False; { Not double click }
  990. MouseButtons := MouseButtons AND NOT
  991. mbRightButton; { Clear button mask }
  992. End;
  993. WM_RButtonDBLClk: Begin { RIGHT MOUSE DBL CLK }
  994. Event.What := evMouseDown; { Mouse down event }
  995. Event.Double := True; { Double click }
  996. MouseButtons := MouseButtons OR
  997. mbLeftButton; { Set button mask }
  998. End;
  999. WM_MButtonDown: Begin { MIDDLE MOUSE DOWN }
  1000. Event.What := evMouseDown; { Mouse down event }
  1001. Event.Double := False; { Not double click }
  1002. MouseButtons := MouseButtons OR
  1003. mbMiddleButton; { Set button mask }
  1004. End;
  1005. WM_MButtonUp: Begin { MIDDLE MOUSE UP }
  1006. Event.What := evMouseUp; { Mouse up event }
  1007. Event.Double := False; { Not double click }
  1008. MouseButtons := MouseButtons AND NOT
  1009. mbMiddleButton; { Clear button mask }
  1010. End;
  1011. WM_MButtonDBLClk: Begin { MIDDLE MOUSE DBL CLK }
  1012. Event.What := evMouseDown; { Mouse down event }
  1013. Event.Double := True; { Double click }
  1014. MouseButtons := MouseButtons OR
  1015. mbMiddleButton; { Set button mask }
  1016. End;
  1017. WM_MouseMove: Begin { MOUSE MOVEMENT }
  1018. Event.What := evMouseMove; { Mouse move event }
  1019. Event.Double := False; { Not double click }
  1020. MouseButtons := 0; { Preset clear buttons }
  1021. If (wParam AND mk_LButton <> 0) Then
  1022. MouseButtons := MouseButtons OR
  1023. mbLeftButton; { Left button mask }
  1024. If (wParam AND mk_MButton <> 0) Then
  1025. MouseButtons := MouseButtons OR
  1026. mbLeftButton; { Middle button mask }
  1027. If (wParam AND mk_RButton <> 0) Then
  1028. MouseButtons := MouseButtons OR
  1029. mbRightButton; { Set right button mask }
  1030. End;
  1031. {$IFDEF BIT_32}
  1032. WM_Notify: Begin
  1033. I := 0;
  1034. End;
  1035. {$ENDIF}
  1036. WM_EraseBkGnd: TvViewMsgHandler := 1; { BACKGROUND MESSAGE }
  1037. WM_Paint: If (P^.Dc = 0) Then Begin { PAINT MESSAGE }
  1038. P^.Dc := BeginPaint(Wnd, Ps); { Fetch structure }
  1039. SelectObject(ps.hDC, DefGFVFont); { Select default font }
  1040. P^.DrawMask := P^.DrawMask OR vdNoChild; { Draw this view only }
  1041. P^.ReDrawArea(Ps.rcPaint.Left + P^.RawOrigin.X,
  1042. Ps.rcPaint.Top + P^.RawOrigin.Y,
  1043. Ps.rcPaint.Right + P^.RawOrigin.X-1,
  1044. Ps.rcPaint.Bottom + P^.RawOrigin.Y-1); { Redraw the area }
  1045. P^.DrawMask := P^.DrawMask AND NOT vdNoChild;{ Child draws enabled }
  1046. P^.Dc := 0; { Zero device context }
  1047. EndPaint(Wnd, Ps); { End painting }
  1048. End Else PostMessage(Wnd, iMessage, wParam,
  1049. lParam); { Busy repost message }
  1050. WM_HScroll, WM_VScroll: Begin { SCROLLBAR MESSAGES }
  1051. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1052. PtrRec(Q).Seg := GetProp(HiWord(lParam),
  1053. ViewSeg); { Fetch seg property }
  1054. PtrRec(Q).Ofs := GetProp(HiWord(lParam),
  1055. ViewOfs); { Fetch ofs property }
  1056. W := wParam; { Transfer word }
  1057. {$ENDIF}
  1058. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1059. LongInt(Q) := GetProp(lParam, ViewPtr); { Fetch seg property }
  1060. W := LoWord(wParam); { Low param part }
  1061. {$ENDIF}
  1062. If (Q <> Nil) Then Begin { Valid scrollbar }
  1063. If (Q^.GetState(sfFocused) = False) Then
  1064. Q^.FocusFromTop; { Focus up to us }
  1065. Bc := 0; { Preset do call }
  1066. Case W Of
  1067. SB_TOP: Q^.SetValue(Q^.Min); { Set to minimum }
  1068. SB_BOTTOM: Q^.SetValue(Q^.Max); { Set to maximum }
  1069. SB_ENDSCROLL: Bc := 1; { Fail this call }
  1070. SB_LINEDOWN: Q^.SetValue(Q^.Value +
  1071. Q^.ScrollStep(sbDownArrow)); { One line down }
  1072. SB_LINEUP: Q^.SetValue(Q^.Value +
  1073. Q^.ScrollStep(sbUpArrow)); { One line up }
  1074. SB_PAGEDOWN: Q^.SetValue(Q^.Value +
  1075. Q^.ScrollStep(sbPageDown)); { One page down }
  1076. SB_PAGEUP: Q^.SetValue(Q^.Value +
  1077. Q^.ScrollStep(sbPageUp)); { One page up }
  1078. SB_THUMBPOSITION, SB_THUMBTRACK:
  1079. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1080. Q^.SetValue(LoWord(lParam)); { Set to position }
  1081. {$ENDIF}
  1082. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1083. Q^.SetValue(HiWord(wParam)); { Set to position }
  1084. {$ENDIF}
  1085. Else Bc := 1; { Fail other cases }
  1086. End;
  1087. If (Bc=0) Then NewMessage(Q^.Owner,
  1088. evBroadcast, cmScrollBarClicked, Q^.Id,
  1089. Q^.Value, Q); { Old TV style message }
  1090. End;
  1091. End;
  1092. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1093. WM_CtlColor: If (HiWord(lParam) = CtlColor_Btn){ COLOUR CONTROL }
  1094. OR (HiWord(lParam) = CtlColor_ListBox)
  1095. {$ENDIF}
  1096. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1097. WM_CtlColorListBox, WM_CtlColorBtn: { COLOUR LISTBOX/BUTTON }
  1098. If (lParam <> 0) { Valid handle }
  1099. {$ENDIF}
  1100. Then Begin
  1101. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1102. PtrRec(P).Seg := GetProp(LoWord(lParam),
  1103. ViewSeg); { Get view segment }
  1104. PtrRec(P).Ofs := GetProp(LoWord(lParam),
  1105. ViewOfs); { Get view segment }
  1106. {$ENDIF}
  1107. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1108. LongInt(P) := GetProp(LoWord(lParam),
  1109. ViewPtr); { Get view pointer }
  1110. {$ENDIF}
  1111. If (P <> Nil) Then Begin { Valid view }
  1112. Bc := P^.GetColor(1) AND $F0 SHR 4; { Background colour }
  1113. SetTextColor(wParam, ColRef[P^.GetColor(1)
  1114. AND $0F]); { Set text colour }
  1115. SetBkColor(wParam, ColRef[Bc]); { Set background colour }
  1116. TvViewMsgHandler := ColBrush[Bc]; { Return colour brush }
  1117. End Else TvViewMsgHandler := DefWindowProc(
  1118. Wnd, iMessage, wParam, lParam); { Call default handler }
  1119. End Else TvViewMsgHandler := DefWindowProc(
  1120. Wnd, iMessage, wParam, lParam); { Call default handler }
  1121. WM_SysCommand: Begin { SYSTEM COMMAND MESSAGE }
  1122. If (P^.GetState(sfFocused) = False) Then
  1123. P^.FocusFromTop; { Focus if behind }
  1124. TvViewMsgHandler := DefWindowProc(
  1125. Wnd, iMessage, wParam, lParam);
  1126. If IsIconic(Wnd) Then BringWindowToTop(Wnd);
  1127. End;
  1128. WM_Command: Begin { COMMAND MESSAGE }
  1129. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1130. W := HiWord(lParam); { Message of lParam }
  1131. {$ENDIF}
  1132. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1133. W := HiWord(wParam); { Handle high of wParam }
  1134. {$ENDIF}
  1135. Case W Of
  1136. cbn_SelChange: Begin { COMBO/LIST SELECTION }
  1137. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1138. PtrRec(Tp).Seg := GetProp(LoWord(lParam),
  1139. ViewSeg); { Fetch combo seg }
  1140. PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
  1141. ViewOfs); { Fetch combo ofs }
  1142. {$ENDIF}
  1143. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1144. LongInt(Tp) := GetProp(LoWord(lParam),
  1145. ViewPtr); { Fetch combo ptr }
  1146. {$ENDIF}
  1147. If (Tp <> Nil) Then Begin { View is valid }
  1148. I := SendMessage(LoWord(lParam),
  1149. Tp^.GetNotifyCmd, 0, 0); { Get current state }
  1150. Event.What := evCommand; { Command event }
  1151. Event.Command := cmNotify; { Notify command }
  1152. Event.data := I; { Load data value }
  1153. Event.InfoPtr := Tp; { Pointer to view }
  1154. End;
  1155. End;
  1156. cbn_SetFocus: Begin { DROP BOX FOCUSED }
  1157. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1158. PtrRec(Tp).Seg := GetProp(LoWord(lParam),
  1159. ViewSeg); { Fetch combo seg }
  1160. PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
  1161. ViewOfs); { Fetch combo ofs }
  1162. {$ENDIF}
  1163. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1164. LongInt(Tp) := GetProp(LoWord(lParam),
  1165. ViewPtr); { Fetch combo ptr }
  1166. {$ENDIF}
  1167. If (Tp <> Nil) AND { Combo box valid }
  1168. (Tp^.GetState(sfFocused) = False) Then { We have not focus }
  1169. Tp^.FocusFromTop; { Focus up to us }
  1170. End;
  1171. lbn_SetFocus: Begin { LIST BOX FOCUSED }
  1172. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1173. PtrRec(Tp).Seg := GetProp(LoWord(lParam),
  1174. ViewSeg); { Fetch listbox seg }
  1175. PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
  1176. ViewOfs); { Fetch listbox ofs }
  1177. {$ENDIF}
  1178. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1179. LongInt(Tp) := GetProp(LoWord(lParam),
  1180. ViewPtr); { Fetch listbox ptr }
  1181. {$ENDIF}
  1182. If (Tp <> Nil) Then Begin { Listbox is valid }
  1183. If (Tp^.GetState(sfFocused) = False) { We have not focus }
  1184. Then Tp^.FocusFromTop; { Focus up to us }
  1185. End;
  1186. End;
  1187. Else TvViewMsgHandler := DefWindowProc(
  1188. Wnd, iMessage, wParam, lParam); { Call default handler }
  1189. End;
  1190. End;
  1191. WM_Activate, WM_ChildActivate: Begin
  1192. If (P^.Options AND ofTopSelect <> 0) { Top selectable view }
  1193. AND (P^.Options AND ofSelectable <> 0) { View is selectable }
  1194. Then P^.FocusFromTop; { Focus us from top }
  1195. End;
  1196. WM_WindowPosChanged: Begin { WINDOW HAS MOVED }
  1197. If (NOT ISIconic(Wnd)) AND (lParam <> 0) { Window not iconic }
  1198. Then Begin
  1199. Wp := Pointer(lParam); { TWindowpos structure }
  1200. If (Wp^.Flags AND swp_NoMove = 0) { No move flag is clear }
  1201. Then Begin
  1202. If (P^.Owner <> Nil) Then
  1203. P^.DisplaceBy(Wp^.X + P^.Owner^.RawOrigin.X -
  1204. P^.RawOrigin.X + P^.Owner^.FrameSize,
  1205. Wp^.Y + P^.Owner^.RawOrigin.Y -
  1206. P^.RawOrigin.Y + P^.Owner^.CaptSize) { Displace the window }
  1207. Else P^.DisplaceBy(Wp^.X + P^.RawOrigin.X,
  1208. Wp^.Y - P^.RawOrigin.Y); { Displace the window }
  1209. End;
  1210. If (Wp^.Flags AND swp_NoSize = 0) { No resize flag clear }
  1211. Then Begin
  1212. P^.RawSize.X := Wp^.Cx; { Size the window x }
  1213. P^.RawSize.Y := Wp^.Cy; { Size the window y }
  1214. End;
  1215. End;
  1216. TvViewMsgHandler := DefWindowProc(Wnd,
  1217. iMessage, wParam, lParam); { Default handler }
  1218. End;
  1219. Else TvViewMsgHandler := DefWindowProc(Wnd,
  1220. iMessage, wParam, lParam); { Call Default handler }
  1221. End; { End of case }
  1222. If (Event.What <> evNothing) Then Begin { Check any GFV event }
  1223. If (Event.What AND evMouse <> 0) Then Begin { Mouse event }
  1224. If (P <> Nil) Then Begin { Valid view pointer }
  1225. Event.Where.X := LoWord(lParam) +
  1226. P^.RawOrigin.X + P^.FrameSize; { X mouse co-ordinate }
  1227. Event.Where.Y := HiWord(lParam) +
  1228. P^.RawOrigin.Y + P^.CaptSize; { Y mouse co-ordinate }
  1229. MouseWhere := Event.Where; { Update mouse where }
  1230. Event.Buttons := MouseButtons; { Return mouse buttons }
  1231. End Else Exit; { View is not valid }
  1232. End;
  1233. PutEventInQueue(Event); { Put event in queue }
  1234. End;
  1235. End Else TvViewMsgHandler := DefWindowProc(Wnd,
  1236. iMessage, wParam, lParam); { Call Default handler }
  1237. END;
  1238. {$ENDIF}
  1239. {$IFDEF OS_OS2} { OS2 CODE }
  1240. {---------------------------------------------------------------------------}
  1241. { TvViewMsgHandler -> Platforms OS2 - Updated 09Aug99 LdB }
  1242. {---------------------------------------------------------------------------}
  1243. FUNCTION TvViewMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult;
  1244. VAR Bc: Byte; R: RectL; Event: TEvent; P: PView; Pt: PointL; PS: hPs; Sp: Swp;
  1245. Q: PScrollBar; Sh: HWnd;
  1246. BEGIN
  1247. P := Nil; { Clear the pointer }
  1248. WinQueryPresParam(Wnd, PP_User, 0, Nil,
  1249. SizeOf(Pointer), @P, 0); { Fetch view pointer }
  1250. If (P <> Nil) Then Begin { PView is valid }
  1251. TvViewMSgHandler := 0; { Preset handled }
  1252. Event.What := evNothing; { Preset no event }
  1253. Case Msg Of
  1254. WM_Close: Begin { CLOSE COMMAND }
  1255. If (P^.GetState(sfFocused) = False) Then
  1256. P^.FocusFromTop; { Focus if behind }
  1257. Event.What := evCommand; { Command event }
  1258. Event.Command := cmClose; { Quit command }
  1259. Event.InfoPtr := P; { Pointer to view }
  1260. End;
  1261. WM_EraseBackGround: TvViewMsgHandler := { BACKGROUND ERASE }
  1262. LongInt(False); { Return false }
  1263. WM_Paint: If (P^.Ps = 0) Then Begin { PAINT MESSAGE }
  1264. P^.Ps := WinBeginPaint(Wnd, 0, @R); { Fetch structure }
  1265. P^.DrawMask := P^.DrawMask OR vdNoChild; { Draw this view only }
  1266. P^.ReDrawArea(R.xLeft + P^.RawOrigin.X,
  1267. R.yBottom + P^.RawOrigin.Y,
  1268. R.xRight + P^.RawOrigin.X,
  1269. R.yTop + P^.RawOrigin.Y); { Redraw the area }
  1270. P^.DrawMask := P^.DrawMask AND NOT vdNoChild;{ Child draws enabled }
  1271. P^.Ps := 0; { Zero device context }
  1272. WinEndPaint(Ps); { End painting }
  1273. End Else WinPostMsg(Wnd, Msg, Mp1, Mp2); { Busy repost message }
  1274. WM_Button1Down: Begin { LEFT MOUSE DOWN }
  1275. Event.What := evMouseDown; { Mouse down event }
  1276. Event.Double := False; { Not double click }
  1277. MouseButtons := MouseButtons OR
  1278. mbLeftButton; { Set button mask }
  1279. End;
  1280. WM_Button1Up: Begin { LEFT MOUSE UP }
  1281. Event.What := evMouseUp; { Mouse up event }
  1282. Event.Double := False; { Not double click }
  1283. MouseButtons := MouseButtons AND NOT
  1284. mbLeftButton; { Clear button mask }
  1285. End;
  1286. WM_Button1DBLClk: Begin { LEFT MOUSE DBL CLK }
  1287. Event.What := evMouseDown; { Mouse down event }
  1288. Event.Double := True; { Double click }
  1289. MouseButtons := MouseButtons OR
  1290. mbLeftButton; { Set button mask }
  1291. End;
  1292. WM_Button2Down: Begin { RIGHT MOUSE DOWN }
  1293. Event.What := evMouseDown; { Mouse down event }
  1294. Event.Double := False; { Not double click }
  1295. MouseButtons := MouseButtons OR
  1296. mbRightButton; { Set button mask }
  1297. End;
  1298. WM_Button2Up: Begin { RIGHT MOUSE UP }
  1299. Event.What := evMouseUp; { Mouse up event }
  1300. Event.Double := False; { Not double click }
  1301. MouseButtons := MouseButtons AND NOT
  1302. mbRightButton; { Clear button mask }
  1303. End;
  1304. WM_Button2DBLClk: Begin { RIGHT MOUSE DBL CLK }
  1305. Event.What := evMouseDown; { Mouse down event }
  1306. Event.Double := True; { Double click }
  1307. MouseButtons := MouseButtons OR
  1308. mbLeftButton; { Set button mask }
  1309. End;
  1310. WM_Button3Down: Begin { MIDDLE MOUSE DOWN }
  1311. Event.What := evMouseDown; { Mouse down event }
  1312. Event.Double := False; { Not double click }
  1313. MouseButtons := MouseButtons OR
  1314. mbMiddleButton; { Set button mask }
  1315. End;
  1316. WM_Button3Up: Begin { MIDDLE MOUSE UP }
  1317. Event.What := evMouseUp; { Mouse up event }
  1318. Event.Double := False; { Not double click }
  1319. MouseButtons := MouseButtons AND NOT
  1320. mbMiddleButton; { Clear button mask }
  1321. End;
  1322. WM_Button3DBLClk: Begin { MIDDLE MOUSE DBL CLK }
  1323. Event.What := evMouseDown; { Mouse down event }
  1324. Event.Double := True; { Double click }
  1325. MouseButtons := MouseButtons OR
  1326. mbMiddleButton; { Set button mask }
  1327. End;
  1328. WM_MouseMove: Begin { MOUSE MOVEMENT }
  1329. Event.What := evMouseMove; { Mouse move event }
  1330. Event.Double := False; { Not double click }
  1331. If (WinQueryPointer(HWND_Desktop) <>
  1332. DefPointer) Then { Check mouse ptr }
  1333. WinSetPointer(HWND_DeskTop, DefPointer); { Set mouse ptr }
  1334. End;
  1335. WM_HScroll, WM_VScroll: Begin { SCROLLBAR MESSAGES }
  1336. Q := Nil; { Clear the pointer }
  1337. Sh := WinQueryFocus(HWnd_DeskTop); { Scrollbar has focus }
  1338. If (Sh <> 0) Then WinQueryPresParam(Sh,
  1339. PP_User, 0, Nil, SizeOf(Pointer), @Q, 0); { Fetch scrollbar ptr }
  1340. If (Q <> Nil) AND (Q^.GOptions AND
  1341. goNativeClass <> 0) Then Begin { Valid scrollbar }
  1342. If (Q^.GetState(sfFocused) = False) Then
  1343. Q^.FocusFromTop; { Focus up to us }
  1344. Bc := 0; { Preset do call }
  1345. Case Short2FromMP(Mp2) Of { Scrollbar message }
  1346. SB_ENDSCROLL:;
  1347. SB_LINEDOWN: Q^.SetValue(Q^.Value +
  1348. Q^.ScrollStep(sbDownArrow)); { One line down }
  1349. SB_LINEUP: Q^.SetValue(Q^.Value +
  1350. Q^.ScrollStep(sbUpArrow)); { One line up }
  1351. SB_PAGEDOWN: Q^.SetValue(Q^.Value +
  1352. Q^.ScrollStep(sbPageDown)); { One page down }
  1353. SB_PAGEUP: Q^.SetValue(Q^.Value +
  1354. Q^.ScrollStep(sbPageUp)); { One page up }
  1355. SB_SLIDERPOSITION, SB_SLIDERTRACK:
  1356. Q^.SetValue(Short1FromMP(Mp2)); { Set to position }
  1357. Else Bc := 1; { Fail other cases }
  1358. End;
  1359. If (Bc=0) Then NewMessage(Q^.Owner,
  1360. evBroadcast, cmScrollBarClicked, Q^.Id,
  1361. Q^.Value, Q); { Old TV style message }
  1362. End;
  1363. End;
  1364. WM_QueryTrackInfo: Begin { WINDOW HAS MOVED }
  1365. (*If (NOT ISIconic(Wnd)) AND (lParam <> 0) { Window not iconic }
  1366. Then Begin*)
  1367. (*Sp := PSwp(Mp1)^; { New SWP data }
  1368. If (Sp.Fl AND swp_Size <> 0) Then Begin { Size change request }
  1369. P^.RawSize.X := Sp.Cx-1; { Size the window x }
  1370. P^.RawSize.Y := Sp.Cy-1; { Size the window y }
  1371. End;*)
  1372. (*P^.DisplaceBy(Sp1.X - Sp2.X,
  1373. -(Sp1.Y - Sp2.Y));*)
  1374. TvViewMSgHandler := 0;
  1375. End;
  1376. Else TvViewMSgHandler := WinDefWindowProc(
  1377. Wnd, Msg, Mp1, Mp2); { Call default handler }
  1378. End;
  1379. If (Event.What <> evNothing) Then Begin { Check any FV event }
  1380. If (Event.What AND evMouse <> 0) Then Begin { Mouse event }
  1381. WinQueryWindowPos(Wnd, Sp); { Query client area }
  1382. Event.Where.X := Short1FromMP(Mp1)-1
  1383. + P^.RawOrigin.X; { X mouse co-ordinate }
  1384. Event.Where.Y := Sp.Cy -
  1385. Short2FromMP(Mp1)-1 + P^.RawOrigin.Y; { Y mouse co-ordinate }
  1386. Event.Buttons := MouseButtons; { Return buttons }
  1387. MouseWhere := Event.Where; { Update mouse where }
  1388. End;
  1389. PutEventInQueue(Event); { Put event in queue }
  1390. End;
  1391. End Else TvViewMSgHandler := WinDefWindowProc(Wnd,
  1392. Msg, Mp1, Mp2); { Call default handler }
  1393. END;
  1394. {$ENDIF}
  1395. {***************************************************************************}
  1396. { OBJECT METHODS }
  1397. {***************************************************************************}
  1398. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1399. { TView OBJECT METHODS }
  1400. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1401. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  1402. {---------------------------------------------------------------------------}
  1403. { TView WINDOW CLASS NAME CONSTANT }
  1404. {---------------------------------------------------------------------------}
  1405. CONST TvViewClassName = 'TVIEW'; { TView window class }
  1406. {$ENDIF}
  1407. {--TView--------------------------------------------------------------------}
  1408. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20Jun96 LdB }
  1409. {---------------------------------------------------------------------------}
  1410. CONSTRUCTOR TView.Init (Var Bounds: TRect);
  1411. BEGIN
  1412. Inherited Init; { Call ancestor }
  1413. DragMode := dmLimitLoY; { Default drag mode }
  1414. HelpCtx := hcNoContext; { Clear help context }
  1415. State := sfVisible; { Default state }
  1416. EventMask := evMouseDown + evKeyDown + evCommand; { Default event masks }
  1417. GOptions := goTabSelect; { Set new options }
  1418. SetBounds(Bounds); { Set view bounds }
  1419. END;
  1420. {--TView--------------------------------------------------------------------}
  1421. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  1422. {---------------------------------------------------------------------------}
  1423. { This load method will read old original TV data from a stream but the }
  1424. { new options and tabmasks are not set so some NEW functionality is not }
  1425. { supported but it should work as per original TV code. }
  1426. {---------------------------------------------------------------------------}
  1427. CONSTRUCTOR TView.Load (Var S: TStream);
  1428. BEGIN
  1429. Inherited Init; { Call ancestor }
  1430. S.Read(Origin.X, 2); { Read origin x value }
  1431. S.Read(Origin.Y, 2); { Read origin y value }
  1432. S.Read(Size.X, 2); { Read view x size }
  1433. S.Read(Size.Y, 2); { Read view y size }
  1434. S.Read(Cursor.X, 2); { Read cursor x size }
  1435. S.Read(Cursor.Y, 2); { Read cursor y size }
  1436. S.Read(GrowMode, 1); { Read growmode flags }
  1437. S.Read(DragMode, 1); { Read dragmode flags }
  1438. S.Read(HelpCtx, 2); { Read help context }
  1439. S.Read(State, 2); { Read state masks }
  1440. S.Read(Options, 2); { Read options masks }
  1441. S.Read(Eventmask, 2); { Read event masks }
  1442. If (Options AND ofGFVModeView <> 0) Then Begin { STREAM HAS GFV TVIEW }
  1443. S.Read(GOptions, 2); { Read new option masks }
  1444. S.Read(TabMask, 1); { Read new tab masks }
  1445. S.Read(RawOrigin.X, 2); { Read raw x origin point }
  1446. S.Read(RawOrigin.Y, 2); { Read raw y origin point }
  1447. S.Read(RawSize.X, 2); { Read raw x size }
  1448. S.Read(RawSize.Y, 2); { Read raw y size }
  1449. S.Read(ColourOfs, 2); { Read palette offset }
  1450. End Else Begin { STREAM HAS OLD TView }
  1451. RawOrigin.X := Origin.X * FontWidth; { Set x origin pt }
  1452. RawOrigin.Y := Origin.Y * FontHeight; { Set y origin pt }
  1453. RawSize.X := (Size.X * FontWidth) - 1; { Calc raw x size }
  1454. RawSize.Y := (Size.Y * FontHeight) - 1; { Calc raw y size }
  1455. End;
  1456. END;
  1457. {--TView--------------------------------------------------------------------}
  1458. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Nov99 LdB }
  1459. {---------------------------------------------------------------------------}
  1460. DESTRUCTOR TView.Done;
  1461. VAR P: PComplexArea; {$IFNDEF OS_DOS} S: String; {$ENDIF}
  1462. BEGIN
  1463. Hide; { Hide the view }
  1464. If (Owner <> Nil) Then Owner^.Delete(@Self); { Delete from owner }
  1465. While (HoldLimit <> Nil) Do Begin { Free limit memory }
  1466. P := HoldLimit^.NextArea; { Hold next pointer }
  1467. FreeMem(HoldLimit, SizeOf(TComplexArea)); { Release memory }
  1468. HoldLimit := P; { Shuffle to next }
  1469. End;
  1470. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  1471. If (HWindow <> 0) Then Begin { Handle valid }
  1472. S := GetClassName + #0; { Make asciiz }
  1473. {$IFDEF OS_WINDOWS} { WIN/NT CODE}
  1474. {$IFDEF BIT_16} { 16 BIT CODE }
  1475. RemoveProp(HWindow, ViewSeg); { Remove seg property }
  1476. RemoveProp(HWindow, ViewOfs); { Remove offs property }
  1477. {$ENDIF}
  1478. {$IFDEF BIT_32} { 32 BIT CODE }
  1479. RemoveProp(HWindow, ViewPtr); { Remove view property }
  1480. {$ENDIF}
  1481. DestroyWindow(HWindow); { Destroy window }
  1482. If (GOptions AND goNativeClass = 0) Then { Not native class check }
  1483. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  1484. UnRegisterClass(CString(@S[1]), 0); { Unregister class }
  1485. {$ELSE} { OTHER COMPILERS }
  1486. UnRegisterClass(@S[1], HInstance); { Unregister class }
  1487. {$ENDIF}
  1488. {$ENDIF}
  1489. {$IFDEF OS_OS2} { OS2 CODE }
  1490. WinRemovePresParam(HWindow, PP_User); { Remove self ptr }
  1491. WinDestroyWindow(HWindow); { Destroy window }
  1492. If (GOptions AND goNativeClass = 0) Then { Not native class check }
  1493. WinDeregisterObjectClass(@S[1]); { Unregister class }
  1494. {$ENDIF}
  1495. End;
  1496. {$ENDIF}
  1497. END;
  1498. {--TView--------------------------------------------------------------------}
  1499. { Prev -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1500. {---------------------------------------------------------------------------}
  1501. FUNCTION TView.Prev: PView;
  1502. VAR P: PView;
  1503. BEGIN
  1504. P := @Self; { Start with self }
  1505. While (P^.Next <> Nil) AND (P^.Next <> @Self)
  1506. Do P := P^.Next; { Locate next view }
  1507. Prev := P; { Return result }
  1508. END;
  1509. {--TView--------------------------------------------------------------------}
  1510. { Execute -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1511. {---------------------------------------------------------------------------}
  1512. FUNCTION TView.Execute: Word;
  1513. BEGIN
  1514. Execute := cmCancel; { Return cancel }
  1515. END;
  1516. {--TView--------------------------------------------------------------------}
  1517. { Focus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  1518. {---------------------------------------------------------------------------}
  1519. FUNCTION TView.Focus: Boolean;
  1520. VAR Res: Boolean;
  1521. BEGIN
  1522. Res := True; { Preset result }
  1523. If (State AND (sfSelected + sfModal)=0) Then Begin { Not modal/selected }
  1524. If (Owner <> Nil) Then Begin { View has an owner }
  1525. Res := Owner^.Focus; { Return focus state }
  1526. If Res Then { Owner has focus }
  1527. If ((Owner^.Current = Nil) OR { No current view }
  1528. (Owner^.Current^.Options AND ofValidate = 0) { Non validating view }
  1529. OR (Owner^.Current^.Valid(cmReleasedFocus))) { Okay to drop focus }
  1530. Then Select Else Res := False; { Then select us }
  1531. End;
  1532. End;
  1533. Focus := Res; { Return focus result }
  1534. END;
  1535. {--TView--------------------------------------------------------------------}
  1536. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1537. {---------------------------------------------------------------------------}
  1538. FUNCTION TView.DataSize: Word;
  1539. BEGIN
  1540. DataSize := 0; { Transfer size }
  1541. END;
  1542. {--TView--------------------------------------------------------------------}
  1543. { TopView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1544. {---------------------------------------------------------------------------}
  1545. FUNCTION TView.TopView: PView;
  1546. VAR P: PView;
  1547. BEGIN
  1548. If (TheTopView = Nil) Then Begin { Check topmost view }
  1549. P := @Self; { Start with us }
  1550. While (P <> Nil) AND (P^.State AND sfModal = 0) { Check if modal }
  1551. Do P := P^.Owner; { Search each owner }
  1552. TopView := P; { Return result }
  1553. End Else TopView := TheTopView; { Return topview }
  1554. END;
  1555. {--TView--------------------------------------------------------------------}
  1556. { PrevView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1557. {---------------------------------------------------------------------------}
  1558. FUNCTION TView.PrevView: PView;
  1559. BEGIN
  1560. If (@Self = Owner^.First) Then PrevView := Nil { We are first view }
  1561. Else PrevView := Prev; { Return our prior }
  1562. END;
  1563. {--TView--------------------------------------------------------------------}
  1564. { NextView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1565. {---------------------------------------------------------------------------}
  1566. FUNCTION TView.NextView: PView;
  1567. BEGIN
  1568. If (@Self = Owner^.Last) Then NextView := Nil { This is last view }
  1569. Else NextView := Next; { Return our next }
  1570. END;
  1571. {--TView--------------------------------------------------------------------}
  1572. { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1573. {---------------------------------------------------------------------------}
  1574. FUNCTION TView.GetHelpCtx: Word;
  1575. BEGIN
  1576. If (State AND sfDragging <> 0) Then { Dragging state check }
  1577. GetHelpCtx := hcDragging Else { Return dragging }
  1578. GetHelpCtx := HelpCtx; { Return help context }
  1579. END;
  1580. {--TView--------------------------------------------------------------------}
  1581. { EventAvail -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1582. {---------------------------------------------------------------------------}
  1583. FUNCTION TView.EventAvail: Boolean;
  1584. VAR Event: TEvent;
  1585. BEGIN
  1586. GetEvent(Event); { Get next event }
  1587. If (Event.What <> evNothing) Then PutEvent(Event); { Put it back }
  1588. EventAvail := (Event.What <> evNothing); { Return result }
  1589. END;
  1590. {--TView--------------------------------------------------------------------}
  1591. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1592. {---------------------------------------------------------------------------}
  1593. FUNCTION TView.GetPalette: PPalette;
  1594. BEGIN
  1595. GetPalette := Nil; { Return nil ptr }
  1596. END;
  1597. {--TView--------------------------------------------------------------------}
  1598. { GetColor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB }
  1599. {---------------------------------------------------------------------------}
  1600. FUNCTION TView.GetColor (Color: Word): Word;
  1601. VAR Col: Byte; W: Word; P: PPalette; Q: PView;
  1602. BEGIN
  1603. W := 0; { Clear colour word }
  1604. If (Hi(Color) > 0) Then Begin { High colour req }
  1605. Col := Hi(Color) + ColourOfs; { Initial offset }
  1606. Q := @Self; { Pointer to self }
  1607. Repeat
  1608. P := Q^.GetPalette; { Get our palette }
  1609. If (P <> Nil) Then Begin { Palette is valid }
  1610. If (Col <= Length(P^)) Then
  1611. Col := Ord(P^[Col]) Else { Return colour }
  1612. Col := ErrorAttr; { Error attribute }
  1613. End;
  1614. Q := Q^.Owner; { Move up to owner }
  1615. Until (Q = Nil); { Until no owner }
  1616. W := Col SHL 8; { Translate colour }
  1617. End;
  1618. If (Lo(Color) > 0) Then Begin
  1619. Col := Lo(Color) + ColourOfs; { Initial offset }
  1620. Q := @Self; { Pointer to self }
  1621. Repeat
  1622. P := Q^.GetPalette; { Get our palette }
  1623. If (P <> Nil) Then Begin { Palette is valid }
  1624. If (Col <= Length(P^)) Then
  1625. Col := Ord(P^[Col]) Else { Return colour }
  1626. Col := ErrorAttr; { Error attribute }
  1627. End;
  1628. Q := Q^.Owner; { Move up to owner }
  1629. Until (Q = Nil); { Until no owner }
  1630. End Else Col := ErrorAttr; { No colour found }
  1631. GetColor := W OR Col; { Return color }
  1632. END;
  1633. {--TView--------------------------------------------------------------------}
  1634. { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1635. {---------------------------------------------------------------------------}
  1636. FUNCTION TView.Valid (Command: Word): Boolean;
  1637. BEGIN
  1638. Valid := True; { Simply return true }
  1639. END;
  1640. {--TView--------------------------------------------------------------------}
  1641. { GetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1642. {---------------------------------------------------------------------------}
  1643. FUNCTION TView.GetState (AState: Word): Boolean;
  1644. BEGIN
  1645. GetState := State AND AState = AState; { Check states equal }
  1646. END;
  1647. {--TView--------------------------------------------------------------------}
  1648. { TextWidth -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Nov99 LdB }
  1649. {---------------------------------------------------------------------------}
  1650. FUNCTION TView.TextWidth (Txt: String): Integer;
  1651. VAR I: Integer; S: String;
  1652. {$IFNDEF OS_DOS} P: Pointer; Wnd: HWnd; {$ENDIF}
  1653. {$IFDEF OS_WINDOWS} ODc: HDc; M: TSize; {$ENDIF}
  1654. {$IFDEF OS_OS2} OPs: HPs; Pt: Array [0..3] Of PointL; {$ENDIF}
  1655. BEGIN
  1656. S := Txt; { Transfer text }
  1657. Repeat
  1658. I := Pos('~', S); { Check for tilde }
  1659. If (I <> 0) Then System.Delete(S, I, 1); { Remove the tilde }
  1660. Until (I = 0); { Remove all tildes }
  1661. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1662. TextWidth := Length(S) * SysFontWidth; { Calc text length }
  1663. {$ENDIF}
  1664. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1665. ODc := Dc; { Hold device context }
  1666. If (Dc = 0) Then Begin { No context set }
  1667. If (HWindow = 0) OR (State AND sfVisible = 0) { Check window valid }
  1668. OR (State AND sfExposed = 0)
  1669. Then Wnd := AppWindow Else Wnd := HWindow; { Select window or app }
  1670. Dc := GetDC(Wnd); { Get device context }
  1671. End;
  1672. SelectObject(Dc, DefGFVFont); { Select the font }
  1673. P := @S[1]; { Pointer to text }
  1674. {$IFDEF BIT_32} { WINDOWS 32 BIT CODE }
  1675. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  1676. If (GetTextExtentPoint(Dc, CString(P),
  1677. Length(S), M)=False) Then M.Cx := 0; { Get text extents }
  1678. {$ELSE} { OTHER COMPILERS }
  1679. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  1680. If (GetTextExtentPoint(Dc, P, Length(S),
  1681. @M)=False) Then M.Cx := 0; { Get text extents }
  1682. {$ELSE} { ALL OTHER COMPILERS }
  1683. If (GetTextExtentPoint(Dc, P, Length(S),
  1684. M)=False) Then M.Cx := 0; { Get text extents }
  1685. {$ENDIF}
  1686. {$ENDIF}
  1687. {$ELSE} { WINDOWS 16 BIT CODE }
  1688. {$IFDEF PPC_DELPHI} { DELPHI1 COMPILER }
  1689. If (GetTextExtentPoint(Dc, @S[1], Length(S),
  1690. M)=False)Then M.Cx := 0; { Get text extents }
  1691. {$ELSE} { OTHER COMPILERS }
  1692. If (GetTextExtentPoint(Dc, @S[1], Length(S),
  1693. M.Cx)=False)Then M.Cx := 0; { Get text extents }
  1694. {$ENDIF}
  1695. {$ENDIF}
  1696. TextWidth := M.Cx; { Return text width }
  1697. If (ODc = 0) Then ReleaseDC(Wnd, Dc); { Release context }
  1698. Dc := ODc; { Original context set }
  1699. {$ENDIF}
  1700. {$IFDEF OS_OS2}
  1701. OPs := Ps; { Hold pres space }
  1702. If (Ps = 0) Then Begin
  1703. If (HWindow = 0) OR (State AND sfVisible = 0) { Check window valid }
  1704. OR (State AND sfExposed = 0)
  1705. Then Wnd := AppWindow Else Wnd := Client; { Select window or app }
  1706. Ps := WinGetPS(Wnd); { Get pres space }
  1707. End;
  1708. GPISetCharSet(PS, DefGFVFont); { Set the font style }
  1709. P := @S[1]; { Pointer to text }
  1710. GpiQueryTextBox(Ps, Length(S), P, 3, Pt[0]); { Get text extents }
  1711. TextWidth := Pt[2].X; { Return text width }
  1712. If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
  1713. Ps := OPs; { Original pres space }
  1714. {$ENDIF}
  1715. END;
  1716. {--TView--------------------------------------------------------------------}
  1717. { MouseInView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1718. {---------------------------------------------------------------------------}
  1719. FUNCTION TView.MouseInView (Point: TPoint): Boolean;
  1720. BEGIN
  1721. MouseInView := False; { Preset false }
  1722. If (Point.X < RawOrigin.X) Then Exit; { Point to left }
  1723. If (Point.X > (RawOrigin.X+RawSize.X)) Then Exit; { Point to right }
  1724. If (Point.Y < RawOrigin.Y) Then Exit; { Point is above }
  1725. If (Point.Y > (RawOrigin.Y+RawSize.Y)) Then Exit; { Point is below }
  1726. MouseInView := True; { Return true }
  1727. END;
  1728. {--TView--------------------------------------------------------------------}
  1729. { CommandEnabled -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1730. {---------------------------------------------------------------------------}
  1731. FUNCTION TView.CommandEnabled(Command: Word): Boolean;
  1732. BEGIN
  1733. CommandEnabled := (Command > 255) OR
  1734. (Command IN CurCommandSet); { Check command }
  1735. END;
  1736. {--TView--------------------------------------------------------------------}
  1737. { OverLapsArea -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1738. {---------------------------------------------------------------------------}
  1739. FUNCTION TView.OverlapsArea (X1, Y1, X2, Y2: Integer): Boolean;
  1740. BEGIN
  1741. OverLapsArea := False; { Preset false }
  1742. If (RawOrigin.X > X2) Then Exit; { Area to the left }
  1743. If ((RawOrigin.X + RawSize.X) < X1) Then Exit; { Area to the right }
  1744. If (RawOrigin.Y > Y2) Then Exit; { Area is above }
  1745. If ((RawOrigin.Y + RawSize.Y) < Y1) Then Exit; { Area is below }
  1746. OverLapsArea := True; { Return true }
  1747. END;
  1748. {--TView--------------------------------------------------------------------}
  1749. { MouseEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1750. {---------------------------------------------------------------------------}
  1751. FUNCTION TView.MouseEvent (Var Event: TEvent; Mask: Word): Boolean;
  1752. BEGIN
  1753. Repeat
  1754. GetEvent(Event); { Get next event }
  1755. Until (Event.What AND (Mask OR evMouseUp) <> 0); { Wait till valid }
  1756. MouseEvent := Event.What <> evMouseUp; { Return result }
  1757. END;
  1758. {--TView--------------------------------------------------------------------}
  1759. { Hide -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1760. {---------------------------------------------------------------------------}
  1761. PROCEDURE TView.Hide;
  1762. BEGIN
  1763. If (State AND sfVisible <> 0) Then { View is visible }
  1764. SetState(sfVisible, False); { Hide the view }
  1765. END;
  1766. {--TView--------------------------------------------------------------------}
  1767. { Show -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1768. {---------------------------------------------------------------------------}
  1769. PROCEDURE TView.Show;
  1770. BEGIN
  1771. If (State AND sfVisible = 0) Then { View not visible }
  1772. SetState(sfVisible, True); { Show the view }
  1773. END;
  1774. {--TView--------------------------------------------------------------------}
  1775. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1776. {---------------------------------------------------------------------------}
  1777. PROCEDURE TView.Draw;
  1778. BEGIN { Abstract method }
  1779. END;
  1780. {--TView--------------------------------------------------------------------}
  1781. { Select -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  1782. {---------------------------------------------------------------------------}
  1783. PROCEDURE TView.Select;
  1784. BEGIN
  1785. If (Options AND ofSelectable <> 0) Then { View is selectable }
  1786. If (Options AND ofTopSelect <> 0) Then MakeFirst { Top selectable }
  1787. Else If (Owner <> Nil) Then { Valid owner }
  1788. Owner^.SetCurrent(@Self, NormalSelect); { Make owners current }
  1789. END;
  1790. {--TView--------------------------------------------------------------------}
  1791. { Awaken -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1792. {---------------------------------------------------------------------------}
  1793. PROCEDURE TView.Awaken;
  1794. BEGIN { Abstract method }
  1795. END;
  1796. {--TView--------------------------------------------------------------------}
  1797. { DrawView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  1798. {---------------------------------------------------------------------------}
  1799. PROCEDURE TView.DrawView;
  1800. VAR ViewPort: ViewPortType; { Common variables }
  1801. {$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF} { WIN/NT variables }
  1802. {$IFDEF OS_OS2} OPs: HPs; {$ENDIF} { OS2 variables }
  1803. BEGIN
  1804. If (State AND sfVisible <> 0) AND { View is visible }
  1805. (State AND sfExposed <> 0) AND { View is exposed }
  1806. (State AND sfIconised = 0) Then Begin { View not iconised }
  1807. SetViewLimits; { Set view limits }
  1808. GetViewSettings(ViewPort); { Get set viewport }
  1809. If OverlapsArea(ViewPort.X1, ViewPort.Y1,
  1810. ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
  1811. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1812. HideMouseCursor; { Hide mouse cursor }
  1813. {$ENDIF}
  1814. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1815. If (HWindow <> 0) Then Begin { Valid window }
  1816. ODc := Dc; { Hold device context }
  1817. If (Dc = 0) Then Dc := GetDc(HWindow); { Get device context }
  1818. {$ENDIF}
  1819. {$IFDEF OS_OS2} { OS2 CODE }
  1820. If (HWindow <> 0) Then Begin { Valid window }
  1821. OPs := Ps; { Hold paint struct }
  1822. If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
  1823. {$ENDIF}
  1824. If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set }
  1825. Then Begin { Treat as a full redraw }
  1826. DrawBackGround; { Draw background }
  1827. Draw; { Draw interior }
  1828. If (GOptions AND goDrawFocus <> 0) Then
  1829. DrawFocus; { Draw focus }
  1830. If (State AND sfCursorVis <> 0)
  1831. Then DrawCursor; { Draw any cursor }
  1832. If (Options AND ofFramed <> 0) OR
  1833. (GOptions AND goThickFramed <> 0) { View has border }
  1834. Then DrawBorder; { Draw border }
  1835. End Else Begin { Masked draws only }
  1836. If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask }
  1837. DrawBackGround; { Draw background }
  1838. If (DrawMask AND vdInner <> 0) Then { Check Inner mask }
  1839. Draw; { Draw interior }
  1840. If (DrawMask AND vdFocus <> 0)
  1841. AND (GOptions AND goDrawFocus <> 0)
  1842. Then DrawFocus; { Check focus mask }
  1843. If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
  1844. DrawCursor; { Draw any cursor }
  1845. If (DrawMask AND vdBorder <> 0) Then { Check border mask }
  1846. DrawBorder; { Draw border }
  1847. End;
  1848. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1849. ShowMouseCursor; { Show mouse cursor }
  1850. {$ENDIF}
  1851. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1852. If (ODc = 0) Then ReleaseDc(HWindow, Dc); { Release context }
  1853. Dc := ODc; { Reset held context }
  1854. End;
  1855. {$ENDIF}
  1856. {$IFDEF OS_OS2} { OS2 CODE }
  1857. If (OPs = 0) Then WinReleasePS(Ps); { Free paint struct }
  1858. Ps := OPs; { Reset held struct }
  1859. End;
  1860. {$ENDIF}
  1861. End;
  1862. ReleaseViewLimits; { Release the limits }
  1863. End;
  1864. DrawMask := 0; { Clear the draw mask }
  1865. END;
  1866. {--TView--------------------------------------------------------------------}
  1867. { MakeFirst -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  1868. {---------------------------------------------------------------------------}
  1869. PROCEDURE TView.MakeFirst;
  1870. BEGIN
  1871. If (Owner <> Nil) Then Begin { Must have owner }
  1872. PutInFrontOf(Owner^.First); { Float to the top }
  1873. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1874. If (HWindow <> 0) Then { Valid window }
  1875. SetWindowPos(HWindow, HWND_TOP, 0, 0, 0, 0,
  1876. swp_NoSize OR swp_NoMove); { Bring window to top }
  1877. {$ENDIF}
  1878. {$IFDEF OS_OS2} { OS2 CODE }
  1879. If (HWindow <> 0) Then { Valid window }
  1880. WinSetWindowPos(HWindow, HWND_TOP, 0, 0, 0, 0,
  1881. swp_ZOrder); { Bring window to top }
  1882. {$ENDIF}
  1883. End;
  1884. END;
  1885. {--TView--------------------------------------------------------------------}
  1886. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1887. {---------------------------------------------------------------------------}
  1888. PROCEDURE TView.DrawFocus;
  1889. BEGIN { Abstract method }
  1890. END;
  1891. {--TView--------------------------------------------------------------------}
  1892. { DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1893. {---------------------------------------------------------------------------}
  1894. PROCEDURE TView.DrawCursor;
  1895. BEGIN { Abstract method }
  1896. END;
  1897. {--TView--------------------------------------------------------------------}
  1898. { DrawBorder -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17May98 LdB }
  1899. {---------------------------------------------------------------------------}
  1900. PROCEDURE TView.DrawBorder;
  1901. BEGIN
  1902. {$IFDEF OS_DOS} { DOS/DPMI CODE ONLY }
  1903. BiColorRectangle(0, 0, RawSize.X, RawSize.Y, White,
  1904. DarkGray, False); { Draw 3d effect }
  1905. If (GOptions AND goThickFramed <> 0) Then Begin { Thick frame at work }
  1906. GraphRectangle(1, 1, RawSize.X-1, RawSize.Y-1,
  1907. LightGray); { Draw frame part 1 }
  1908. GraphRectangle(2, 2, RawSize.X-2, RawSize.Y-2,
  1909. LightGray); { Fraw frame part 2 }
  1910. BiColorRectangle(3, 3, RawSize.X-3, RawSize.Y-3,
  1911. White, DarkGray, True); { Draw highlights }
  1912. End;
  1913. {$ENDIF}
  1914. END;
  1915. {--TView--------------------------------------------------------------------}
  1916. { HideCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1917. {---------------------------------------------------------------------------}
  1918. PROCEDURE TView.HideCursor;
  1919. BEGIN
  1920. SetState(sfCursorVis , False); { Hide the cursor }
  1921. END;
  1922. {--TView--------------------------------------------------------------------}
  1923. { ShowCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1924. {---------------------------------------------------------------------------}
  1925. PROCEDURE TView.ShowCursor;
  1926. BEGIN
  1927. SetState(sfCursorVis , True); { Show the cursor }
  1928. END;
  1929. {--TView--------------------------------------------------------------------}
  1930. { BlockCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1931. {---------------------------------------------------------------------------}
  1932. PROCEDURE TView.BlockCursor;
  1933. BEGIN
  1934. SetState(sfCursorIns, True); { Set insert mode }
  1935. END;
  1936. {--TView--------------------------------------------------------------------}
  1937. { NormalCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1938. {---------------------------------------------------------------------------}
  1939. PROCEDURE TView.NormalCursor;
  1940. BEGIN
  1941. SetState(sfCursorIns, False); { Clear insert mode }
  1942. END;
  1943. {--TView--------------------------------------------------------------------}
  1944. { FocusFromTop -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11Aug99 LdB }
  1945. {---------------------------------------------------------------------------}
  1946. PROCEDURE TView.FocusFromTop;
  1947. BEGIN
  1948. If (Owner <> Nil) AND
  1949. (Owner^.State AND sfSelected = 0)
  1950. Then Owner^.Select;
  1951. If (State AND sfFocused = 0) Then Focus;
  1952. If (State AND sfSelected = 0) Then Select;
  1953. END;
  1954. {--TView--------------------------------------------------------------------}
  1955. { SetViewLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Sep99 LdB }
  1956. {---------------------------------------------------------------------------}
  1957. PROCEDURE TView.SetViewLimits;
  1958. VAR X1, Y1, X2, Y2: Integer; P: PGroup; ViewPort: ViewPortType; Ca: PComplexArea;
  1959. BEGIN
  1960. If (MaxAvail >= SizeOf(TComplexArea)) Then Begin { Check enough memory }
  1961. GetMem(Ca, SizeOf(TComplexArea)); { Allocate memory }
  1962. GetViewSettings(ViewPort); { Fetch view port }
  1963. Ca^.X1 := ViewPort.X1; { Hold current X1 }
  1964. Ca^.Y1 := ViewPort.Y1; { Hold current Y1 }
  1965. Ca^.X2 := ViewPort.X2; { Hold current X2 }
  1966. Ca^.Y2 := ViewPort.Y2; { Hold current Y2 }
  1967. Ca^.NextArea := HoldLimit; { Pointer to next }
  1968. HoldLimit := Ca; { Move down chain }
  1969. X1 := RawOrigin.X; { Xfer x raw origin }
  1970. Y1 := RawOrigin.Y; { Xfer y raw origin }
  1971. X2 := X1 + RawSize.X; { Calc right value }
  1972. Y2 := Y1 + RawSize.Y; { Calc lower value }
  1973. P := Owner; { Start on owner }
  1974. While (P <> Nil) Do Begin { While owner valid }
  1975. If (X1 < P^.RawOrigin.X) Then
  1976. X1 := P^.RawOrigin.X; { X minimum contain }
  1977. If (Y1 < P^.RawOrigin.Y) Then
  1978. Y1 := P^.RawOrigin.Y; { Y minimum contain }
  1979. If (X2 > P^.RawOrigin.X + P^.RawSize.X)
  1980. Then X2 := P^.RawOrigin.X + P^.RawSize.X; { X maximum contain }
  1981. If (Y2 > P^.RawOrigin.Y + P^.RawSize.Y)
  1982. Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain }
  1983. P := P^.Owner; { Move to owners owner }
  1984. End;
  1985. If (LimitsLocked <> Nil) Then Begin { Locked = area redraw }
  1986. If (X2 < ViewPort.X1) Then Exit; { View left of locked }
  1987. If (X1 > ViewPort.X2) Then Exit; { View right of locked }
  1988. If (Y2 < ViewPort.Y1) Then Exit; { View above locked }
  1989. If (Y1 > ViewPort.Y2) Then Exit; { View below locked }
  1990. If (X1 < ViewPort.X1) Then X1 := ViewPort.X1; { Adjust x1 to locked }
  1991. If (Y1 < ViewPort.Y1) Then Y1 := ViewPort.Y1; { Adjust y1 to locked }
  1992. If (X2 > ViewPort.X2) Then X2 := ViewPort.X2; { Adjust x2 to locked }
  1993. If (Y2 > ViewPort.Y2) Then Y2 := ViewPort.Y2; { Adjust y2 to locked }
  1994. End;
  1995. SetViewPort(X1, Y1, X2, Y2, ClipOn); { Set new clip limits }
  1996. End;
  1997. END;
  1998. {--TView--------------------------------------------------------------------}
  1999. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 21Sep99 LdB }
  2000. {---------------------------------------------------------------------------}
  2001. PROCEDURE TView.DrawBackGround;
  2002. VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
  2003. {$IFDEF OS_OS2} Ptl: PointL; {$ENDIF}
  2004. BEGIN
  2005. If (GOptions AND goNoDrawView = 0) Then Begin { Non draw views exit }
  2006. If (State AND sfDisabled = 0) Then
  2007. Bc := GetColor(1) AND $F0 SHR 4 Else { Select back colour }
  2008. Bc := GetColor(4) AND $F0 SHR 4; { Disabled back colour }
  2009. GetViewSettings(ViewPort); { Get view settings }
  2010. If (ViewPort.X1 <= RawOrigin.X) Then X1 := 0 { Right to left edge }
  2011. Else X1 := ViewPort.X1-RawOrigin.X; { Offset from left }
  2012. If (ViewPort.Y1 <= RawOrigin.Y) Then Y1 := 0 { Right to top edge }
  2013. Else Y1 := ViewPort.Y1-RawOrigin.Y; { Offset from top }
  2014. If (ViewPort.X2 >= RawOrigin.X+RawSize.X) Then
  2015. X2 := RawSize.X Else { Right to right edge }
  2016. X2 := ViewPort.X2-RawOrigin.X; { Offset from right }
  2017. If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
  2018. Y2 := RawSize.Y Else { Right to bottom edge }
  2019. Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
  2020. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2021. SetFillStyle(SolidFill, Bc); { Set fill colour }
  2022. Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
  2023. {$ENDIF}
  2024. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2025. If (Dc <> 0) Then Begin { Valid device context }
  2026. SelectObject(Dc, ColBrush[Bc]); { Select brush }
  2027. SelectObject(Dc, ColPen[Bc]); { Select pen }
  2028. Rectangle(Dc, X1, Y1, X2+1, Y2+1); { Clear the view area }
  2029. End;
  2030. {$ENDIF}
  2031. {$IFDEF OS_OS2} { OS2 CODE }
  2032. If (Ps <> 0) Then Begin { Valid pres space }
  2033. GpiSetColor(Ps, ColRef[Bc]); { Select colour }
  2034. Ptl.X := X1; { X1 position }
  2035. Ptl.Y := RawSize.Y - Y1; { Y1 position }
  2036. GpiMove(PS, Ptl); { Move to position }
  2037. Ptl.X := X2; { X2 position }
  2038. Ptl.Y := RawSize.Y - Y2; { Y2 position }
  2039. GpiBox(Ps, dro_Fill, Ptl, 0, 0); { Clear the view area }
  2040. End;
  2041. {$ENDIF}
  2042. End;
  2043. END;
  2044. {--TView--------------------------------------------------------------------}
  2045. { ReleaseViewLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  2046. {---------------------------------------------------------------------------}
  2047. PROCEDURE TView.ReleaseViewLimits;
  2048. VAR P: PComplexArea;
  2049. BEGIN
  2050. P := HoldLimit; { Transfer pointer }
  2051. If (P <> Nil) Then Begin { Valid complex area }
  2052. HoldLimit := P^.NextArea; { Move to prior area }
  2053. SetViewPort(P^.X1, P^.Y1, P^.X2, P^.Y2, ClipOn); { Restore clip limits }
  2054. FreeMem(P, SizeOf(TComplexArea)); { Release memory }
  2055. End;
  2056. END;
  2057. {--TView--------------------------------------------------------------------}
  2058. { MoveTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2059. {---------------------------------------------------------------------------}
  2060. PROCEDURE TView.MoveTo (X, Y: Integer);
  2061. VAR R: TRect;
  2062. BEGIN
  2063. R.Assign(X, Y, X + Size.X, Y + Size.Y); { Assign area }
  2064. Locate(R); { Locate the view }
  2065. END;
  2066. {--TView--------------------------------------------------------------------}
  2067. { GrowTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2068. {---------------------------------------------------------------------------}
  2069. PROCEDURE TView.GrowTo (X, Y: Integer);
  2070. VAR R: TRect;
  2071. BEGIN
  2072. R.Assign(Origin.X, Origin.Y, Origin.X + X,
  2073. Origin.Y + Y); { Assign area }
  2074. Locate(R); { Locate the view }
  2075. END;
  2076. {--TView--------------------------------------------------------------------}
  2077. { SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
  2078. {---------------------------------------------------------------------------}
  2079. PROCEDURE TView.SetDrawMask (Mask: Byte);
  2080. BEGIN
  2081. If (Options AND ofFramed = 0) AND { Check for no frame }
  2082. (GOptions AND goThickFramed = 0) AND { Check no thick frame }
  2083. (GOptions AND goTitled = 0) Then { Check for title }
  2084. Mask := Mask AND NOT vdBorder; { Clear border draw }
  2085. If (State AND sfCursorVis = 0) Then { Check for no cursor }
  2086. Mask := Mask AND NOT vdCursor; { Clear cursor draw }
  2087. If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
  2088. Mask := Mask AND NOT vdFocus; { Clear focus draws }
  2089. DrawMask := DrawMask OR Mask; { Set draw masks }
  2090. END;
  2091. {--TView--------------------------------------------------------------------}
  2092. { EndModal -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2093. {---------------------------------------------------------------------------}
  2094. PROCEDURE TView.EndModal (Command: Word);
  2095. VAR P: PView;
  2096. BEGIN
  2097. P := TopView; { Get top view }
  2098. If (P <> Nil) Then P^.EndModal(Command); { End modal operation }
  2099. END;
  2100. {--TView--------------------------------------------------------------------}
  2101. { SetCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  2102. {---------------------------------------------------------------------------}
  2103. PROCEDURE TView.SetCursor (X, Y: Integer);
  2104. BEGIN
  2105. Cursor.X := X; { New x position }
  2106. Cursor.Y := Y; { New y position }
  2107. If (State AND sfCursorVis <> 0) Then Begin { Cursor visible }
  2108. SetDrawMask(vdCursor); { Set draw mask }
  2109. DrawView; { Draw the cursor }
  2110. End;
  2111. END;
  2112. {--TView--------------------------------------------------------------------}
  2113. { PutInFrontOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  2114. {---------------------------------------------------------------------------}
  2115. PROCEDURE TView.PutInFrontOf (Target: PView);
  2116. VAR P, LastView: PView;
  2117. BEGIN
  2118. If (Owner <> Nil) AND (Target <> @Self) AND
  2119. (Target <> NextView) AND ((Target = Nil) OR
  2120. (Target^.Owner = Owner)) Then { Check validity }
  2121. If (State AND sfVisible = 0) Then Begin { View not visible }
  2122. Owner^.RemoveView(@Self); { Remove from list }
  2123. Owner^.InsertView(@Self, Target); { Insert into list }
  2124. End Else Begin
  2125. LastView := NextView; { Hold next view }
  2126. If (LastView <> Nil) Then Begin { Lastview is valid }
  2127. P := Target; { P is target }
  2128. While (P <> Nil) AND (P <> LastView)
  2129. Do P := P^.NextView; { Find our next view }
  2130. If (P = Nil) Then LastView := Target; { Lastview is target }
  2131. End;
  2132. State := State AND NOT sfVisible; { Temp stop drawing }
  2133. If (LastView = Target) Then
  2134. If (Owner <> Nil) Then Owner^.ReDrawArea(
  2135. RawOrigin.X, RawOrigin.Y, RawOrigin.X +
  2136. RawSize.X, RawOrigin.Y + RawSize.Y); { Redraw old area }
  2137. Owner^.RemoveView(@Self); { Remove from list }
  2138. Owner^.InsertView(@Self, Target); { Insert into list }
  2139. State := State OR sfVisible; { Allow drawing again }
  2140. If (LastView <> Target) Then DrawView; { Draw the view now }
  2141. If (Options AND ofSelectable <> 0) Then { View is selectable }
  2142. If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
  2143. End;
  2144. END;
  2145. { ******************************* REMARK ****************************** }
  2146. { The original TV origin data is only adjusted incase the user uses }
  2147. { the values directly. New views should rely only on RawOrigin values. }
  2148. { ****************************** END REMARK *** Leon de Boer, 15May98 * }
  2149. {--TView--------------------------------------------------------------------}
  2150. { DisplaceBy -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB }
  2151. {---------------------------------------------------------------------------}
  2152. PROCEDURE TView.DisplaceBy (Dx, Dy: Integer);
  2153. BEGIN
  2154. RawOrigin.X := RawOrigin.X + Dx; { Displace raw x }
  2155. RawOrigin.Y := RawOrigin.Y + Dy; { Displace raw y }
  2156. Origin.X := RawOrigin.X DIV FontWidth; { Calc new x origin }
  2157. Origin.Y := RawOrigin.Y DIV FontHeight; { Calc new y origin }
  2158. END;
  2159. {--TView--------------------------------------------------------------------}
  2160. { SetCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2161. {---------------------------------------------------------------------------}
  2162. PROCEDURE TView.SetCommands (Commands: TCommandSet);
  2163. BEGIN
  2164. CommandSetChanged := CommandSetChanged OR
  2165. (CurCommandSet <> Commands); { Set change flag }
  2166. CurCommandSet := Commands; { Set command set }
  2167. END;
  2168. {--TView--------------------------------------------------------------------}
  2169. { ReDrawArea -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  2170. {---------------------------------------------------------------------------}
  2171. PROCEDURE TView.ReDrawArea (X1, Y1, X2, Y2: Integer);
  2172. VAR HLimit: PView; ViewPort: ViewPortType;
  2173. BEGIN
  2174. GetViewSettings(ViewPort); { Hold view port }
  2175. SetViewPort(X1, Y1, X2, Y2, ClipOn); { Set new clip limits }
  2176. HLimit := LimitsLocked; { Hold lock limits }
  2177. LimitsLocked := @Self; { We are the lock view }
  2178. DrawView; { Redraw the area }
  2179. LimitsLocked := HLimit; { Release our lock }
  2180. SetViewPort(ViewPort.X1, ViewPort.Y1,
  2181. ViewPort.X2, ViewPort.Y2, ClipOn); { Reset old limits }
  2182. END;
  2183. {--TView--------------------------------------------------------------------}
  2184. { EnableCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2185. {---------------------------------------------------------------------------}
  2186. PROCEDURE TView.EnableCommands (Commands: TCommandSet);
  2187. BEGIN
  2188. CommandSetChanged := CommandSetChanged OR
  2189. (CurCommandSet * Commands <> Commands); { Set changed flag }
  2190. CurCommandSet := CurCommandSet + Commands; { Update command set }
  2191. END;
  2192. {--TView--------------------------------------------------------------------}
  2193. { DisableCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2194. {---------------------------------------------------------------------------}
  2195. PROCEDURE TView.DisableCommands (Commands: TCommandSet);
  2196. BEGIN
  2197. CommandSetChanged := CommandSetChanged OR
  2198. (CurCommandSet * Commands <> []); { Set changed flag }
  2199. CurCommandSet := CurCommandSet - Commands; { Update command set }
  2200. END;
  2201. {--TView--------------------------------------------------------------------}
  2202. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
  2203. {---------------------------------------------------------------------------}
  2204. PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
  2205. VAR Command: Word;
  2206. BEGIN
  2207. If Enable Then State := State OR AState { Set state mask }
  2208. Else State := State AND NOT AState; { Clear state mask }
  2209. If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
  2210. If (Owner <> Nil) AND { valid owner }
  2211. (Owner^.State AND sfExposed <> 0) { If owner exposed }
  2212. Then SetState(sfExposed, Enable); { Expose this view }
  2213. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2214. If Enable Then DrawView Else { Draw the view }
  2215. If (Owner <> Nil) Then Owner^.ReDrawArea( { Owner valid }
  2216. RawOrigin.X, RawOrigin.Y, RawOrigin.X +
  2217. RawSize.X, RawOrigin.Y + RawSize.Y); { Owner redraws area }
  2218. {$ENDIF}
  2219. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2220. If (HWindow <> 0) Then Begin { Window handle valid }
  2221. If Enable Then ShowWindow(HWindow, sw_Show) { Show the window }
  2222. Else ShowWindow(HWindow, sw_Hide); { Hide the window }
  2223. End;
  2224. {$ENDIF}
  2225. {$IFDEF OS_OS2} { OS2 CODE }
  2226. If (HWindow <> 0) Then Begin { Window handle valid }
  2227. If Enable Then WinSetWindowPos(HWindow, 0, 0,
  2228. 0, 0, 0, swp_Show) { Show the window }
  2229. Else WinSetWindowPos(HWindow, 0, 0, 0, 0, 0,
  2230. swp_Hide); { Hide the window }
  2231. End;
  2232. {$ENDIF}
  2233. If (Options AND ofSelectable <> 0) Then { View is selectable }
  2234. If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset selected }
  2235. End;
  2236. If (AState AND sfFocused <> 0) Then Begin { Focus change }
  2237. If (Owner <> Nil) Then Begin { Owner valid }
  2238. If Enable Then Command := cmReceivedFocus { View gaining focus }
  2239. Else Command := cmReleasedFocus; { View losing focus }
  2240. Message(Owner, evBroadcast, Command, @Self); { Send out message }
  2241. End;
  2242. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2243. If (HWindow <> 0) Then { Window handle valid }
  2244. If Enable Then SetFocus(HWindow); { Focus the window }
  2245. {$ENDIF}
  2246. {$IFDEF OS_OS2} { OS2 CODE }
  2247. If (HWindow <> 0) Then { Window handle valid }
  2248. If Enable Then WinSetFocus(HWND_DESKTOP,
  2249. HWindow); { Focus the window }
  2250. {$ENDIF}
  2251. If (GOptions AND goDrawFocus <> 0) Then Begin { Draw focus view }
  2252. SetDrawMask(vdFocus); { Set focus draw mask }
  2253. DrawView; { Redraw focus change }
  2254. End;
  2255. End;
  2256. If (AState AND (sfCursorVis + sfCursorIns) <> 0) { Change cursor state }
  2257. Then Begin
  2258. SetDrawMask(vdCursor); { Set cursor draw mask }
  2259. DrawView; { Redraw the cursor }
  2260. End;
  2261. If (AState AND sfDisabled <> 0) Then Begin { Disbale change }
  2262. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2263. If (HWindow <> 0) Then { Window handle valid }
  2264. If Enable Then EnableWindow(HWindow, False) { Disable the window }
  2265. Else EnableWindow(HWindow, True); { Enable the window }
  2266. {$ENDIF}
  2267. {$IFDEF OS_OS2} { OS2 CODE }
  2268. If (HWindow <> 0) Then { Window handle valid }
  2269. If Enable Then WinEnableWindow(HWindow,False) { Disable the window }
  2270. Else WinEnableWindow(HWindow, True); { Enable the window }
  2271. {$ENDIF}
  2272. End;
  2273. If (AState AND sfShadow <> 0) Then Begin End; { Change shadow state }
  2274. END;
  2275. {--TView--------------------------------------------------------------------}
  2276. { SetCmdState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2277. {---------------------------------------------------------------------------}
  2278. PROCEDURE TView.SetCmdState (Commands: TCommandSet; Enable: Boolean);
  2279. BEGIN
  2280. If Enable Then EnableCommands(Commands) { Enable commands }
  2281. Else DisableCommands(Commands); { Disable commands }
  2282. END;
  2283. {--TView--------------------------------------------------------------------}
  2284. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2285. {---------------------------------------------------------------------------}
  2286. PROCEDURE TView.GetData (Var Rec);
  2287. BEGIN { Abstract method }
  2288. END;
  2289. {--TView--------------------------------------------------------------------}
  2290. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2291. {---------------------------------------------------------------------------}
  2292. PROCEDURE TView.SetData (Var Rec);
  2293. BEGIN { Abstract method }
  2294. END;
  2295. {--TView--------------------------------------------------------------------}
  2296. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  2297. {---------------------------------------------------------------------------}
  2298. { You can save data to the stream compatable with the old original TV by }
  2299. { temporarily turning off the ofGFVModeView making the call to this store }
  2300. { routine and resetting the ofGFVModeView flag after the call. }
  2301. {---------------------------------------------------------------------------}
  2302. PROCEDURE TView.Store (Var S: TStream);
  2303. VAR SaveState: Word;
  2304. BEGIN
  2305. SaveState := State; { Hold current state }
  2306. State := State AND NOT (sfActive OR sfSelected OR
  2307. sfFocused OR sfExposed); { Clear flags }
  2308. S.Write(Origin.X, 2); { Write view x origin }
  2309. S.Write(Origin.Y, 2); { Write view y origin }
  2310. S.Write(Size.X, 2); { Write view x size }
  2311. S.Write(Size.Y, 2); { Write view y size }
  2312. S.Write(Cursor.X, 2); { Write cursor x size }
  2313. S.Write(Cursor.Y, 2); { Write cursor y size }
  2314. S.Write(GrowMode, 1); { Write growmode flags }
  2315. S.Write(DragMode, 1); { Write dragmode flags }
  2316. S.Write(HelpCtx, 2); { Write help context }
  2317. S.Write(State, 2); { Write state masks }
  2318. S.Write(Options, 2); { Write options masks }
  2319. S.Write(Eventmask, 2); { Write event masks }
  2320. If (Options AND ofGFVModeView <> 0) Then Begin { GFV GRAPHICAL TVIEW }
  2321. S.Write(GOptions, 2); { Write new option masks }
  2322. S.Write(TabMask, 1); { Write new tab masks }
  2323. S.Write(RawOrigin.X, 2); { Write raw origin x point }
  2324. S.Write(RawOrigin.Y, 2); { Write raw origin y point }
  2325. S.Write(RawSize.X, 2); { Write raw x size }
  2326. S.Write(RawSize.Y, 2); { Write raw y size }
  2327. S.Write(ColourOfs, 2); { Write Palette offset }
  2328. End;
  2329. State := SaveState; { Reset state masks }
  2330. END;
  2331. {--TView--------------------------------------------------------------------}
  2332. { Locate -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB }
  2333. {---------------------------------------------------------------------------}
  2334. PROCEDURE TView.Locate (Var Bounds: TRect);
  2335. VAR {$IFDEF OS_DOS} X1, Y1, X2, Y2: Integer; {$ENDIF}
  2336. Min, Max: TPoint; R: TRect;
  2337. FUNCTION Range(Val, Min, Max: Integer): Integer;
  2338. BEGIN
  2339. If (Val < Min) Then Range := Min Else { Value to small }
  2340. If (Val > Max) Then Range := Max Else { Value to large }
  2341. Range := Val; { Value is okay }
  2342. END;
  2343. BEGIN
  2344. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2345. X1 := RawOrigin.X; { Current x origin }
  2346. Y1 := RawOrigin.Y; { Current y origin }
  2347. X2 := RawOrigin.X + RawSize.X; { Current x size }
  2348. Y2 := RawOrigin.Y + RawSize.Y; { Current y size }
  2349. {$ENDIF}
  2350. SizeLimits(Min, Max); { Get size limits }
  2351. Bounds.B.X := Bounds.A.X + Range(Bounds.B.X -
  2352. Bounds.A.X, Min.X, Max.X); { X bound limit }
  2353. Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y
  2354. - Bounds.A.Y, Min.Y, Max.Y); { Y bound limit }
  2355. GetBounds(R); { Current bounds }
  2356. If NOT Bounds.Equals(R) Then Begin { Size has changed }
  2357. ChangeBounds(Bounds); { Change bounds }
  2358. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2359. If (State AND sfVisible <> 0) AND { View is visible }
  2360. (State AND sfExposed <> 0) AND (Owner <> Nil) { Check view exposed }
  2361. Then Owner^.ReDrawArea(X1, Y1, X2, Y2); { Owner redraw }
  2362. DrawView; { Redraw the view }
  2363. {$ENDIF}
  2364. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2365. If (HWindow <> 0) Then Begin { Valid window handle }
  2366. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner }
  2367. Then MoveWindow(HWindow, RawOrigin.X-Owner^.RawOrigin.X,
  2368. RawOrigin.Y-Owner^.RawOrigin.Y, RawSize.X+1,
  2369. RawSize.Y+1, True) Else { Move window in owner }
  2370. MoveWindow(HWindow, RawOrigin.X, RawOrigin.Y,
  2371. RawSize.X+1, RawSize.Y+1, True); { Move window raw }
  2372. End;
  2373. {$ENDIF}
  2374. {$IFDEF OS_OS2} { OS2 CODE }
  2375. If (HWindow <> 0) Then Begin { Valid window handle }
  2376. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner }
  2377. Then WinSetWindowPos(HWindow, 0,
  2378. RawOrigin.X - Owner^.RawOrigin.X,
  2379. (Owner^.RawOrigin.Y + Owner^.RawSize.Y) -
  2380. (RawOrigin.Y + RawSize.Y), RawSize.X,
  2381. RawSize.Y, swp_Size OR swp_Move) Else { Move window in owner }
  2382. WinSetWindowPos(HWindow, 0, RawOrigin.X,
  2383. SysScreenHeight - (RawOrigin.Y + RawSize.Y),
  2384. RawSize.X, RawSize.Y, swp_Size OR swp_Move); { Move window raw }
  2385. End;
  2386. {$ENDIF}
  2387. End;
  2388. END;
  2389. {--TView--------------------------------------------------------------------}
  2390. { KeyEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2391. {---------------------------------------------------------------------------}
  2392. PROCEDURE TView.KeyEvent (Var Event: TEvent);
  2393. BEGIN
  2394. Repeat
  2395. GetEvent(Event); { Get next event }
  2396. Until (Event.What = evKeyDown); { Wait till keydown }
  2397. END;
  2398. {--TView--------------------------------------------------------------------}
  2399. { GetEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2400. {---------------------------------------------------------------------------}
  2401. PROCEDURE TView.GetEvent (Var Event: TEvent);
  2402. BEGIN
  2403. If (Owner <> Nil) Then Owner^.GetEvent(Event); { Event from owner }
  2404. END;
  2405. {--TView--------------------------------------------------------------------}
  2406. { PutEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2407. {---------------------------------------------------------------------------}
  2408. PROCEDURE TView.PutEvent (Var Event: TEvent);
  2409. BEGIN
  2410. If (Owner <> Nil) Then Owner^.PutEvent(Event); { Put in owner }
  2411. END;
  2412. {--TView--------------------------------------------------------------------}
  2413. { GetExtent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2414. {---------------------------------------------------------------------------}
  2415. PROCEDURE TView.GetExtent (Var Extent: TRect);
  2416. BEGIN
  2417. Extent.A.X := 0; { Zero x field }
  2418. Extent.A.Y := 0; { Zero y field }
  2419. Extent.B.X := Size.X; { Return x size }
  2420. Extent.B.Y := Size.Y; { Return y size }
  2421. END;
  2422. {--TView--------------------------------------------------------------------}
  2423. { GetBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2424. {---------------------------------------------------------------------------}
  2425. PROCEDURE TView.GetBounds (Var Bounds: TRect);
  2426. BEGIN
  2427. Bounds.A := Origin; { Get first corner }
  2428. Bounds.B.X := Origin.X + Size.X; { Calc corner x value }
  2429. Bounds.B.Y := Origin.Y + Size.Y; { Calc corner y value }
  2430. If (Owner <> Nil) Then
  2431. Bounds.Move(-Owner^.Origin.X, -Owner^.Origin.Y); { Sub owner offset }
  2432. END;
  2433. {--TView--------------------------------------------------------------------}
  2434. { SetBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB }
  2435. {---------------------------------------------------------------------------}
  2436. PROCEDURE TView.SetBounds (Var Bounds: TRect);
  2437. VAR D, COrigin: TPoint;
  2438. BEGIN
  2439. If (Bounds.B.X > 0) AND (Bounds.B.Y > 0) { Normal text co-ords }
  2440. AND (GOptions AND goGraphView = 0) Then Begin { Normal text view }
  2441. If (Owner <> Nil) Then Begin { Owner is valid }
  2442. COrigin.X := Origin.X - Owner^.Origin.X; { Corrected x origin }
  2443. COrigin.Y := Origin.Y - Owner^.Origin.Y; { Corrected y origin }
  2444. D.X := Bounds.A.X - COrigin.X; { X origin disp }
  2445. D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp }
  2446. If ((D.X <> 0) OR (D.Y <> 0)) Then
  2447. DisplaceBy(D.X*FontWidth, D.Y*FontHeight); { Offset the view }
  2448. End Else Origin := Bounds.A; { Hold as origin }
  2449. Size.X := Bounds.B.X-Bounds.A.X; { Hold view x size }
  2450. Size.Y := Bounds.B.Y-Bounds.A.Y; { Hold view y size }
  2451. RawOrigin.X := Origin.X * FontWidth; { Raw x origin }
  2452. RawOrigin.Y := Origin.Y * FontHeight; { Raw y origin }
  2453. RawSize.X := Size.X * FontWidth - 1; { Set raw x size }
  2454. RawSize.Y := Size.Y * FontHeight - 1; { Set raw y size }
  2455. End Else Begin { Graphical co-ords }
  2456. If (Owner <> Nil) Then Begin { Owner is valid }
  2457. COrigin.X := RawOrigin.X - Owner^.RawOrigin.X; { Corrected x origin }
  2458. COrigin.Y := RawOrigin.Y - Owner^.RawOrigin.Y; { Corrected y origin }
  2459. D.X := Bounds.A.X - COrigin.X; { X origin disp }
  2460. D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp }
  2461. If ((D.X <> 0) OR (D.Y <> 0)) Then
  2462. DisplaceBy(D.X, D.Y); { Offset the view }
  2463. End Else RawOrigin := Bounds.A; { Hold as origin }
  2464. RawSize.X := Abs(Bounds.B.X) - Bounds.A.X; { Set raw x size }
  2465. RawSize.Y := Abs(Bounds.B.Y) - Bounds.A.Y; { Set raw y size }
  2466. Origin.X := RawOrigin.X DIV FontWidth; { Rough x position }
  2467. Origin.Y := RawOrigin.Y DIV FontHeight; { Rough y position }
  2468. Size.X := RawSize.X DIV FontWidth; { Rough x size }
  2469. Size.Y := RawSize.Y DIV FontHeight; { Rough y size }
  2470. End;
  2471. Options := Options OR ofGFVModeView; { Now in GFV mode }
  2472. END;
  2473. {--TView--------------------------------------------------------------------}
  2474. { GetClipRect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2475. {---------------------------------------------------------------------------}
  2476. PROCEDURE TView.GetClipRect (Var Clip: TRect);
  2477. BEGIN
  2478. GetBounds(Clip); { Get current bounds }
  2479. If (Owner <> Nil) Then Clip.Intersect(Owner^.Clip);{ Intersect with owner }
  2480. Clip.Move(-Origin.X, -Origin.Y); { Sub owner origin }
  2481. END;
  2482. {--TView--------------------------------------------------------------------}
  2483. { ClearEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2484. {---------------------------------------------------------------------------}
  2485. PROCEDURE TView.ClearEvent (Var Event: TEvent);
  2486. BEGIN
  2487. Event.What := evNothing; { Clear the event }
  2488. Event.InfoPtr := @Self; { Set us as handler }
  2489. END;
  2490. {--TView--------------------------------------------------------------------}
  2491. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2492. {---------------------------------------------------------------------------}
  2493. PROCEDURE TView.HandleEvent (Var Event: TEvent);
  2494. BEGIN
  2495. If (Event.What = evMouseDown) Then { Mouse down event }
  2496. If (State AND (sfSelected OR sfDisabled) = 0) { Not selected/disabled }
  2497. AND (Options AND ofSelectable <> 0) Then { View is selectable }
  2498. If (Focus = False) OR { Not view with focus }
  2499. (Options AND ofFirstClick = 0) { Not 1st click select }
  2500. Then ClearEvent(Event); { Handle the event }
  2501. If (Event.What = evKeyDown) AND { Key down event }
  2502. (Options OR ofGFVModeView <> 0) Then Begin { GFV mode view check }
  2503. If (Owner <> Nil) AND (TabMask <> 0) AND { Owner and tab masks }
  2504. (State AND sfFocused <> 0) Then Begin { View has focus }
  2505. Case Event.KeyCode Of
  2506. kbTab: If (TabMask AND tmTab <> 0) Then { Tab key mask set }
  2507. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2508. kbEnter: If (TabMask AND tmEnter <> 0) Then { Enter key mask set }
  2509. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2510. kbShiftTab: If (TabMask AND tmShiftTab <> 0) { Shit tab mask set }
  2511. Then Owner^.FocusNext(True) Else Exit; { Focus prior view }
  2512. kbLeft: If (TabMask AND tmLeft <> 0) Then { Left arrow mask set }
  2513. Owner^.FocusNext(True) Else Exit; { Focus prior view }
  2514. kbRight: If (TabMask AND tmRight <> 0) Then { Right arrow mask set }
  2515. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2516. kbUp: If (TabMask AND tmUp <> 0) Then { Up arrow mask set }
  2517. Owner^.FocusNext(True) Else Exit; { Focus prior view }
  2518. kbDown: If (TabMask AND tmDown <> 0) Then { Down arrow mask set }
  2519. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2520. Else Exit; { Not a tab key }
  2521. End;
  2522. ClearEvent(Event); { Clear handled events }
  2523. End;
  2524. End;
  2525. END;
  2526. {--TView--------------------------------------------------------------------}
  2527. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2528. {---------------------------------------------------------------------------}
  2529. PROCEDURE TView.ChangeBounds (Var Bounds: TRect);
  2530. BEGIN
  2531. SetBounds(Bounds); { Set new bounds }
  2532. DrawView; { Draw the view }
  2533. END;
  2534. {--TView--------------------------------------------------------------------}
  2535. { SizeLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2536. {---------------------------------------------------------------------------}
  2537. PROCEDURE TView.SizeLimits (Var Min, Max: TPoint);
  2538. BEGIN
  2539. Min.X := 0; { Zero x minimum }
  2540. Min.Y := 0; { Zero y minimum }
  2541. If (Owner = Nil) Then Begin
  2542. Max.X := $7FFF; { Max possible x size }
  2543. Max.Y := $7FFF; { Max possible y size }
  2544. End Else Max := Owner^.Size; { Max owner size }
  2545. END;
  2546. {--TView--------------------------------------------------------------------}
  2547. { GetCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2548. {---------------------------------------------------------------------------}
  2549. PROCEDURE TView.GetCommands (Var Commands: TCommandSet);
  2550. BEGIN
  2551. Commands := CurCommandSet; { Return command set }
  2552. END;
  2553. {--TView--------------------------------------------------------------------}
  2554. { GetPeerViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2555. {---------------------------------------------------------------------------}
  2556. PROCEDURE TView.GetPeerViewPtr (Var S: TStream; Var P);
  2557. VAR Index: Integer;
  2558. BEGIN
  2559. Index := 0; { Zero index value }
  2560. S.Read(Index, 2); { Read view index }
  2561. If (Index = 0) OR (OwnerGroup = Nil) Then { Check for peer views }
  2562. Pointer(P) := Nil Else Begin { Return nil }
  2563. Pointer(P) := FixupList^[Index]; { New view ptr }
  2564. FixupList^[Index] := @P; { Patch this pointer }
  2565. End;
  2566. END;
  2567. {--TView--------------------------------------------------------------------}
  2568. { PutPeerViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2569. {---------------------------------------------------------------------------}
  2570. PROCEDURE TView.PutPeerViewPtr (Var S: TStream; P: PView);
  2571. VAR Index: Integer;
  2572. BEGIN
  2573. If (P = Nil) OR (OwnerGroup = Nil) Then Index := 0 { Return zero index }
  2574. Else Index := OwnerGroup^.IndexOf(P); { Return view index }
  2575. S.Write(Index, 2); { Write the index }
  2576. END;
  2577. {--TView--------------------------------------------------------------------}
  2578. { CalcBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2579. {---------------------------------------------------------------------------}
  2580. PROCEDURE TView.CalcBounds (Var Bounds: TRect; Delta: TPoint);
  2581. VAR S, D: Integer; Min, Max: TPoint;
  2582. FUNCTION Range (Val, Min, Max: Integer): Integer;
  2583. BEGIN
  2584. If (Val < Min) Then Range := Min Else { Value below min }
  2585. If (Val > Max) Then Range := Max Else { Value above max }
  2586. Range := Val; { Accept value }
  2587. END;
  2588. PROCEDURE Grow (Var I: Integer);
  2589. BEGIN
  2590. If (GrowMode AND gfGrowRel = 0) Then Inc(I, D)
  2591. Else I := (I * S + (S - D) SHR 1) DIV (S - D); { Calc grow value }
  2592. END;
  2593. BEGIN
  2594. GetBounds(Bounds); { Get bounds }
  2595. If (GrowMode = 0) Then Exit; { No grow flags exits }
  2596. S := Owner^.Size.X; { Set initial size }
  2597. D := Delta.X; { Set initial delta }
  2598. If (GrowMode AND gfGrowLoX <> 0) Then
  2599. Grow(Bounds.A.X); { Grow left side }
  2600. If (GrowMode AND gfGrowHiX <> 0) Then
  2601. Grow(Bounds.B.X); { Grow right side }
  2602. If (Bounds.B.X - Bounds.A.X > MaxViewWidth) Then
  2603. Bounds.B.X := Bounds.A.X + MaxViewWidth; { Check values }
  2604. S := Owner^.Size.Y; D := Delta.Y; { set initial values }
  2605. If (GrowMode AND gfGrowLoY <> 0) Then
  2606. Grow(Bounds.A.Y); { Grow top side }
  2607. If (GrowMode AND gfGrowHiY <> 0) Then
  2608. Grow(Bounds.B.Y); { grow lower side }
  2609. SizeLimits(Min, Max); { Check sizes }
  2610. Bounds.B.X := Bounds.A.X + Range(Bounds.B.X -
  2611. Bounds.A.X, Min.X, Max.X); { Set right side }
  2612. Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y -
  2613. Bounds.A.Y, Min.Y, Max.Y); { Set lower side }
  2614. END;
  2615. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  2616. {***************************************************************************}
  2617. { TView OBJECT WIN/NT/OS2 ONLY METHODS }
  2618. {***************************************************************************}
  2619. {--TView--------------------------------------------------------------------}
  2620. { GetClassId -> Platforms WIN/NT/OS2 - Updated 29Jul99 LdB }
  2621. {---------------------------------------------------------------------------}
  2622. FUNCTION TView.GetClassId: LongInt;
  2623. BEGIN
  2624. GetClassId := 0; { No view class id }
  2625. END;
  2626. {--TView--------------------------------------------------------------------}
  2627. { GetClassName -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2628. {---------------------------------------------------------------------------}
  2629. FUNCTION TView.GetClassName: String;
  2630. BEGIN
  2631. GetClassName := TvViewClassName; { View class name }
  2632. END;
  2633. {--TView--------------------------------------------------------------------}
  2634. { GetClassText -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2635. {---------------------------------------------------------------------------}
  2636. FUNCTION TView.GetClassText: String;
  2637. BEGIN
  2638. GetClassText := ''; { Return empty string }
  2639. END;
  2640. {--TView--------------------------------------------------------------------}
  2641. { GetClassAttr -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2642. {---------------------------------------------------------------------------}
  2643. FUNCTION TView.GetClassAttr: LongInt;
  2644. VAR Li: LongInt;
  2645. BEGIN
  2646. If (State AND sfVisible = 0) Then Li := 0 { View not visible }
  2647. Else Li := ws_Visible; { View is visible }
  2648. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2649. If (State AND sfDisabled <> 0) Then { Check disabled flag }
  2650. Li := Li OR ws_Disabled; { Set disabled flag }
  2651. If (GOptions AND goTitled <> 0) Then Begin
  2652. Li := Li OR ws_Caption; { View has a caption }
  2653. CaptSize := GetSystemMetrics(SM_CYCaption); { Caption height }
  2654. End;
  2655. If (GOptions AND goThickFramed <> 0) Then Begin
  2656. Li := Li OR ws_ThickFrame; { Thick frame on view }
  2657. FrameSize := GetSystemMetrics(SM_CXFrame); { Frame width }
  2658. If (GOptions AND goTitled = 0) Then
  2659. CaptSize := GetSystemMetrics(SM_CYFrame); { Frame height }
  2660. End Else If (Options AND ofFramed <> 0) Then Begin
  2661. Li := Li OR ws_Border; { Normal frame on view }
  2662. FrameSize := GetSystemMetrics(SM_CXBorder); { Frame width }
  2663. If (GOPtions AND goTitled = 0) Then
  2664. CaptSize := GetSystemMetrics(SM_CYBorder); { Frame height }
  2665. End;
  2666. {$ENDIF}
  2667. {$IFDEF OS_OS2} { OS2 CODE }
  2668. Li := Li OR fcf_NoByteAlign; { Not byte aligned }
  2669. If (GOptions AND goTitled <> 0) Then Begin
  2670. Li := Li OR fcf_TitleBar; { View has a caption }
  2671. CaptSize := WinQuerySysValue(HWND_Desktop,
  2672. SV_CYTitleBar); { Caption height }
  2673. End;
  2674. If (GOptions AND goThickFramed <> 0) Then Begin
  2675. Li := Li OR fcf_DlgBorder; { Thick frame on view }
  2676. FrameSize := WinQuerySysValue(HWND_DeskTop,
  2677. SV_CXSizeBorder); { Frame width }
  2678. CaptSize := CaptSize + WinQuerySysValue(
  2679. HWND_DeskTop, SV_CYSizeBorder); { Frame height }
  2680. End Else If (Options AND ofFramed <> 0) Then Begin
  2681. Li := Li OR fcf_Border; { Normal frame on view }
  2682. FrameSize := WinQuerySysValue(HWND_Desktop,
  2683. SV_CXBorder); { Frame width }
  2684. CaptSize := CaptSize + WinQuerySysValue(
  2685. HWND_DeskTop, SV_CYBorder); { Frame height }
  2686. End;
  2687. {$ENDIF}
  2688. Li := Li OR ws_ClipChildren OR ws_ClipSiblings; { By default clip others }
  2689. GetClassAttr := Li; { Return attributes }
  2690. END;
  2691. {--TView--------------------------------------------------------------------}
  2692. { GetNotifyCmd -> Platforms WIN/NT/OS2 - Updated 06Aug99 LdB }
  2693. {---------------------------------------------------------------------------}
  2694. FUNCTION TView.GetNotifyCmd: LongInt;
  2695. BEGIN
  2696. GetNotifyCmd := -1; { No notify cmd }
  2697. END;
  2698. {--TView--------------------------------------------------------------------}
  2699. { GetMsgHandler -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2700. {---------------------------------------------------------------------------}
  2701. FUNCTION TView.GetMsgHandler: Pointer;
  2702. BEGIN
  2703. GetMsgHandler := @TvViewMsgHandler; { Default msg handler }
  2704. END;
  2705. {$ENDIF}
  2706. {***************************************************************************}
  2707. { TView OBJECT PRIVATE METHODS }
  2708. {***************************************************************************}
  2709. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2710. { TGroup OBJECT METHODS }
  2711. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2712. {--TGroup-------------------------------------------------------------------}
  2713. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul99 LdB }
  2714. {---------------------------------------------------------------------------}
  2715. CONSTRUCTOR TGroup.Init (Var Bounds: TRect);
  2716. BEGIN
  2717. Inherited Init(Bounds); { Call ancestor }
  2718. Options := Options OR (ofSelectable + ofBuffered); { Set options }
  2719. GOptions := GOptions OR goNoDrawView; { Non drawing view }
  2720. GetExtent(Clip); { Get clip extents }
  2721. EventMask := $FFFF; { See all events }
  2722. GOptions := GOptions OR goTabSelect; { Set graphic options }
  2723. END;
  2724. {--TGroup-------------------------------------------------------------------}
  2725. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  2726. {---------------------------------------------------------------------------}
  2727. CONSTRUCTOR TGroup.Load (Var S: TStream);
  2728. VAR I, Count: Word; P, Q: ^Pointer; V: PView; OwnerSave: PGroup;
  2729. FixupSave: PFixupList;
  2730. BEGIN
  2731. Inherited Load(S); { Call ancestor }
  2732. GetExtent(Clip); { Get view extents }
  2733. OwnerSave := OwnerGroup; { Save current group }
  2734. OwnerGroup := @Self; { We are current group }
  2735. FixupSave := FixupList; { Save current list }
  2736. Count := 0; { Zero count value }
  2737. S.Read(Count, 2); { Read entry count }
  2738. If (MaxAvail >= Count*SizeOf(Pointer)) Then Begin { Memory available }
  2739. GetMem(FixupList, Count*SizeOf(Pointer)); { List size needed }
  2740. FillChar(FixUpList^, Count*SizeOf(Pointer), #0); { Zero all entries }
  2741. For I := 1 To Count Do Begin
  2742. V := PView(S.Get); { Get view off stream }
  2743. If (V <> Nil) Then InsertView(V, Nil); { Insert valid views }
  2744. End;
  2745. V := Last; { Start on last view }
  2746. For I := 1 To Count Do Begin
  2747. V := V^.Next; { Fetch next view }
  2748. P := FixupList^[I]; { Transfer pointer }
  2749. While (P <> Nil) Do Begin { If valid view }
  2750. Q := P; { Copy pointer }
  2751. P := P^; { Fetch pointer }
  2752. Q^ := V; { Transfer view ptr }
  2753. End;
  2754. End;
  2755. FreeMem(FixupList, Count*SizeOf(Pointer)); { Release fixup list }
  2756. End;
  2757. OwnerGroup := OwnerSave; { Reload current group }
  2758. FixupList := FixupSave; { Reload current list }
  2759. GetSubViewPtr(S, V); { Load any subviews }
  2760. SetCurrent(V, NormalSelect); { Select current view }
  2761. If (OwnerGroup = Nil) Then Awaken; { If topview activate }
  2762. END;
  2763. {--TGroup-------------------------------------------------------------------}
  2764. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2765. {---------------------------------------------------------------------------}
  2766. DESTRUCTOR TGroup.Done;
  2767. VAR P, T: PView;
  2768. BEGIN
  2769. Hide; { Hide the view }
  2770. P := Last; { Start on last }
  2771. If (P <> Nil) Then Begin { Subviews exist }
  2772. Repeat
  2773. P^.Hide; { Hide each view }
  2774. P := P^.Prev; { Prior view }
  2775. Until (P = Last); { Loop complete }
  2776. Repeat
  2777. T := P^.Prev; { Hold prior pointer }
  2778. Dispose(P, Done); { Dispose subview }
  2779. P := T; { Transfer pointer }
  2780. Until (Last = Nil); { Loop complete }
  2781. End;
  2782. Inherited Done; { Call ancestor }
  2783. END;
  2784. {--TGroup-------------------------------------------------------------------}
  2785. { First -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2786. {---------------------------------------------------------------------------}
  2787. FUNCTION TGroup.First: PView;
  2788. BEGIN
  2789. If (Last = Nil) Then First := Nil { No first view }
  2790. Else First := Last^.Next; { Return first view }
  2791. END;
  2792. {--TGroup-------------------------------------------------------------------}
  2793. { Execute -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2794. {---------------------------------------------------------------------------}
  2795. FUNCTION TGroup.Execute: Word;
  2796. VAR Event: TEvent;
  2797. BEGIN
  2798. Repeat
  2799. EndState := 0; { Clear end state }
  2800. Repeat
  2801. GetEvent(Event); { Get next event }
  2802. HandleEvent(Event); { Handle the event }
  2803. If (Event.What <> evNothing) Then
  2804. EventError(Event); { Event not handled }
  2805. Until (EndState <> 0); { Until command set }
  2806. Until Valid(EndState); { Repeat until valid }
  2807. Execute := EndState; { Return result }
  2808. EndState := 0; { Clear end state }
  2809. END;
  2810. {--TGroup-------------------------------------------------------------------}
  2811. { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2812. {---------------------------------------------------------------------------}
  2813. FUNCTION TGroup.GetHelpCtx: Word;
  2814. VAR H: Word;
  2815. BEGIN
  2816. H := hcNoContext; { Preset no context }
  2817. If (Current <> Nil) Then H := Current^.GetHelpCtx; { Current context }
  2818. If (H=hcNoContext) Then H := Inherited GetHelpCtx; { Call ancestor }
  2819. GetHelpCtx := H; { Return result }
  2820. END;
  2821. {--TGroup-------------------------------------------------------------------}
  2822. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul98 LdB }
  2823. {---------------------------------------------------------------------------}
  2824. FUNCTION TGroup.DataSize: Word;
  2825. VAR Total: Word; P: PView;
  2826. BEGIN
  2827. Total := 0; { Zero totals count }
  2828. P := Last; { Start on last view }
  2829. If (P <> Nil) Then Begin { Subviews exist }
  2830. Repeat
  2831. P := P^.Next; { Move to next view }
  2832. Total := Total + P^.DataSize; { Add view size }
  2833. Until (P = Last); { Until last view }
  2834. End;
  2835. DataSize := Total; { Return data size }
  2836. END;
  2837. {--TGroup-------------------------------------------------------------------}
  2838. { ExecView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul99 LdB }
  2839. {---------------------------------------------------------------------------}
  2840. FUNCTION TGroup.ExecView (P: PView): Word;
  2841. VAR SaveOptions: Word; SaveTopView, SaveCurrent: PView; SaveOwner: PGroup;
  2842. SaveCommands: TCommandSet;
  2843. BEGIN
  2844. If (P<>Nil) Then Begin
  2845. SaveOptions := P^.Options; { Hold options }
  2846. SaveOwner := P^.Owner; { Hold owner }
  2847. SaveTopView := TheTopView; { Save topmost view }
  2848. SaveCurrent := Current; { Save current view }
  2849. GetCommands(SaveCommands); { Save commands }
  2850. TheTopView := P; { Set top view }
  2851. P^.Options := P^.Options AND NOT ofSelectable; { Not selectable }
  2852. P^.SetState(sfModal, True); { Make modal }
  2853. SetCurrent(P, EnterSelect); { Select next }
  2854. If (SaveOwner = Nil) Then Insert(P); { Insert view }
  2855. ExecView := P^.Execute; { Execute view }
  2856. If (SaveOwner = Nil) Then Delete(P); { Remove view }
  2857. SetCurrent(SaveCurrent, LeaveSelect); { Unselect current }
  2858. P^.SetState(sfModal, False); { Clear modal state }
  2859. P^.Options := SaveOptions; { Restore options }
  2860. TheTopView := SaveTopView; { Restore topview }
  2861. SetCommands(SaveCommands); { Restore commands }
  2862. End Else ExecView := cmCancel; { Return cancel }
  2863. END;
  2864. { ********************************* REMARK ******************************** }
  2865. { This call really is very COMPILER SPECIFIC and really can't be done }
  2866. { effectively any other way but assembler code as SELF & FRAMES need }
  2867. { to be put down in exact order and OPTIMIZERS make a mess of it. }
  2868. { ******************************** END REMARK *** Leon de Boer, 17Jul99 *** }
  2869. {--TGroup-------------------------------------------------------------------}
  2870. { FirstThat -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB }
  2871. {---------------------------------------------------------------------------}
  2872. FUNCTION TGroup.FirstThat (P: Pointer): PView; ASSEMBLER;
  2873. {&USES EBX, ECX, ESI, EDI} {&FRAME-}
  2874. {$IFDEF BIT_16} VAR HoldLast: Pointer; {$ENDIF}
  2875. {$IFDEF BIT_16} { 16 BIT CODE }
  2876. ASM
  2877. LES DI, Self; { Load self pointer }
  2878. LES DI, ES:[DI].TGroup.Last; { Fetch last view }
  2879. MOV AX, ES;
  2880. OR AX, DI; { Check for nil }
  2881. JZ @@Exit; { No subviews exit }
  2882. MOV WORD PTR HoldLast[2], ES;
  2883. MOV WORD PTR HoldLast[0], DI; { Hold this last view }
  2884. @@LoopPoint:
  2885. LES DI, ES:[DI].TView.Next; { Move to next view }
  2886. PUSH ES; { * Save this view for }
  2887. PUSH DI; { post call to proc P * }
  2888. PUSH ES;
  2889. PUSH DI; { Push view for proc P }
  2890. MOV AX, [BP]; { Get our frame }
  2891. {$IFNDEF OS_DOS} { WIN/OS2 CODE }
  2892. AND AL, 0FEH; { Must be even }
  2893. {$ENDIF}
  2894. PUSH AX; { Push this frame }
  2895. CALL P; { Call the procedure P }
  2896. POP DI; { * Restore the view }
  2897. POP ES; { we saved above * }
  2898. OR AL, AL; { Look for true result }
  2899. JNZ @@TrueReturned; { Branch if true }
  2900. CMP DI, WORD PTR HoldLast[0]; { HoldLast ofs match? }
  2901. JNZ @@LoopPoint; { No match the continue }
  2902. MOV AX, ES;
  2903. CMP AX, WORD PTR HoldLast[2]; { HoldLast seg match? }
  2904. JNZ @@LoopPoint; { No match continue }
  2905. XOR DI, DI;
  2906. MOV ES, DI; { No matches return nil }
  2907. @@TrueReturned:
  2908. MOV SP, BP; { Restore stack pointer }
  2909. @@Exit:
  2910. MOV AX, DI;
  2911. MOV DX, ES; { Return result pointer }
  2912. END;
  2913. {$ENDIF}
  2914. {$IFDEF BIT_32} { 32 BIT CODE }
  2915. {$IFNDEF PPC_FPC} { NONE FPC COMPILERS }
  2916. ASM
  2917. MOV EAX, Self; { Fetch self pointer }
  2918. MOV EAX, [EAX].TGroup.Last; { Fetch last view }
  2919. OR EAX, EAX; { Check for nil }
  2920. JZ @@Exit; { No subviews exit }
  2921. MOV ECX, EAX; { Hold this last view }
  2922. MOV EBX, P; { Procedure to call }
  2923. @@LoopPoint:
  2924. MOV EAX, [EAX].TView.Next; { Fetch next view }
  2925. PUSH ECX; { Save holdlast view }
  2926. PUSH EBX; { Save procedure address }
  2927. PUSH EAX; { Save for recovery }
  2928. PUSH EAX; { [1]:Pointer = PView }
  2929. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
  2930. DB $66;
  2931. DB $FF;
  2932. DB $D1; { Doesn't know CALL ECX }
  2933. {$ELSE}
  2934. CALL EBX; { Call the test function }
  2935. {$ENDIF}
  2936. TEST AL, AL; { True result check }
  2937. POP EAX; { PView recovered }
  2938. POP EBX; { Restore procedure addr }
  2939. POP ECX; { Restore holdlast view }
  2940. JNZ @@Exit; { Exit if true }
  2941. CMP EAX, ECX; { Check if last view }
  2942. JNZ @@LoopPoint; { Reloop if not last }
  2943. XOR EAX, EAX; { No matches return nil }
  2944. @@Exit:
  2945. END;
  2946. {$ELSE} { FPC COMPILER }
  2947. ASM
  2948. MOVL 8(%EBP), %ESI; { Self pointer }
  2949. MOVL TGroup.Last(%ESI), %EAX; { Load last view }
  2950. ORL %EAX, %EAX; { Check for nil }
  2951. JZ .L_Exit; { No subviews exit }
  2952. MOVL %EAX, %ECX; { Hold last view }
  2953. MOVL P, %EBX; { Procedure to call }
  2954. .L_LoopPoint:
  2955. MOVL TView.Next(%EAX), %EAX; { Fetch next pointer }
  2956. PUSHL %ECX; { Save holdlast view }
  2957. PUSHL %EBX; { Save procedure address }
  2958. PUSHL %EAX; { Save for recovery }
  2959. PUSHL %EAX; { PView pushed }
  2960. MOVL (%EBP), %EAX; { Fetch self ptr }
  2961. PUSH %EAX; { Push self ptr }
  2962. CALL %EBX; { Call the procedure }
  2963. ORB %AL, %AL; { Test for true }
  2964. POPL %EAX; { Recover next PView }
  2965. POPL %EBX; { Restore procedure addr }
  2966. POPL %ECX; { Restore holdlast view }
  2967. JNZ .L_Exit; { Call returned true }
  2968. CMPL %ECX, %EAX; { Check if last view }
  2969. JNZ .L_LoopPoint; { Continue to last }
  2970. XOR %EAX, %EAX; { No views gave true }
  2971. .L_Exit:
  2972. MOVL %EAX, -4(%EBP); { Return result }
  2973. END;
  2974. {$ENDIF}
  2975. {$ENDIF}
  2976. {--TGroup-------------------------------------------------------------------}
  2977. { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2978. {---------------------------------------------------------------------------}
  2979. FUNCTION TGroup.Valid (Command: Word): Boolean;
  2980. FUNCTION IsInvalid (P: PView): Boolean; FAR;
  2981. BEGIN
  2982. IsInvalid := NOT P^.Valid(Command); { Check if valid }
  2983. END;
  2984. BEGIN
  2985. Valid := True; { Preset valid }
  2986. If (Command = cmReleasedFocus) Then Begin { Release focus cmd }
  2987. If (Current <> Nil) AND { Current view exists }
  2988. (Current^.Options AND ofValidate <> 0) Then { Validating view }
  2989. Valid := Current^.Valid(Command); { Validate command }
  2990. End Else Valid := FirstThat(@IsInvalid) = Nil; { Check first valid }
  2991. END;
  2992. {--TGroup-------------------------------------------------------------------}
  2993. { FocusNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2994. {---------------------------------------------------------------------------}
  2995. FUNCTION TGroup.FocusNext (Forwards: Boolean): Boolean;
  2996. VAR P: PView;
  2997. BEGIN
  2998. P := FindNext(Forwards); { Find next view }
  2999. FocusNext := True; { Preset true }
  3000. If (P <> Nil) Then FocusNext := P^.Focus; { Check next focus }
  3001. END;
  3002. {--TGroup-------------------------------------------------------------------}
  3003. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  3004. {---------------------------------------------------------------------------}
  3005. PROCEDURE TGroup.Draw;
  3006. VAR P: PView;
  3007. BEGIN
  3008. If (DrawMask AND vdNoChild = 0) Then Begin { No draw child clear }
  3009. P := Last; { Start on Last }
  3010. While (P <> Nil) Do Begin
  3011. P^.DrawView; { Redraw each subview }
  3012. P := P^.PrevView; { Move to prior view }
  3013. End;
  3014. End;
  3015. END;
  3016. {--TGroup-------------------------------------------------------------------}
  3017. { Awaken -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  3018. {---------------------------------------------------------------------------}
  3019. PROCEDURE TGroup.Awaken;
  3020. PROCEDURE DoAwaken (P: PView); FAR;
  3021. BEGIN
  3022. If (P <> Nil) Then P^.Awaken; { Awaken view }
  3023. END;
  3024. BEGIN
  3025. ForEach(@DoAwaken); { Awaken each view }
  3026. END;
  3027. {--TGroup-------------------------------------------------------------------}
  3028. { ReDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  3029. {---------------------------------------------------------------------------}
  3030. PROCEDURE TGroup.ReDraw;
  3031. BEGIN
  3032. DrawView; { For compatability }
  3033. END;
  3034. {--TGroup-------------------------------------------------------------------}
  3035. { SelectDefaultView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  3036. {---------------------------------------------------------------------------}
  3037. PROCEDURE TGroup.SelectDefaultView;
  3038. VAR P: PView;
  3039. BEGIN
  3040. P := Last; { Start at last }
  3041. While (P <> Nil) Do Begin
  3042. If P^.GetState(sfDefault) Then Begin { Search 1st default }
  3043. P^.Select; { Select default view }
  3044. P := Nil; { Force kick out }
  3045. End Else P := P^.PrevView; { Prior subview }
  3046. End;
  3047. END;
  3048. {--TGroup-------------------------------------------------------------------}
  3049. { Insert -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  3050. {---------------------------------------------------------------------------}
  3051. PROCEDURE TGroup.Insert (P: PView);
  3052. BEGIN
  3053. If (P <> Nil) Then { View is valid }
  3054. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3055. P^.DisplaceBy(RawOrigin.X, RawOrigin.Y) Else { We are in GFV mode }
  3056. P^.DisplaceBy(Origin.X*FontWidth,
  3057. Origin.Y*FontHeight); { Displace old view }
  3058. InsertBefore(P, First); { Insert the view }
  3059. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  3060. If (HWindow <> 0) Then { We are created }
  3061. If (P^.HWindow = 0) Then { Child not created }
  3062. P^.CreateWindowNow(0); { Create child window }
  3063. {$ENDIF}
  3064. END;
  3065. {--TGroup-------------------------------------------------------------------}
  3066. { Delete -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3067. {---------------------------------------------------------------------------}
  3068. PROCEDURE TGroup.Delete (P: PView);
  3069. VAR SaveState: Word;
  3070. BEGIN
  3071. SaveState := P^.State; { Save state }
  3072. P^.Hide; { Hide the view }
  3073. RemoveView(P); { Remove the view }
  3074. P^.Owner := Nil; { Clear owner ptr }
  3075. P^.Next := Nil; { Clear next ptr }
  3076. If (SaveState AND sfVisible <> 0) Then P^.Show; { Show view }
  3077. END;
  3078. { ********************************* REMARK ******************************** }
  3079. { This call really is very COMPILER SPECIFIC and really can't be done }
  3080. { effectively any other way but assembler code as SELF & FRAMES need }
  3081. { to be put down in exact order and OPTIMIZERS make a mess of it. }
  3082. { ******************************** END REMARK *** Leon de Boer, 17Jul99 *** }
  3083. {--TGroup-------------------------------------------------------------------}
  3084. { ForEach -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB }
  3085. {---------------------------------------------------------------------------}
  3086. PROCEDURE TGroup.ForEach (P: Pointer); ASSEMBLER;
  3087. {&USES EBX, ECX, EDI} {&FRAME-}
  3088. VAR HoldLast: Pointer;
  3089. {$IFDEF BIT_16} { 16 BIT CODE }
  3090. ASM
  3091. LES DI, Self; { Load self pointer }
  3092. LES DI, ES:[DI].TGroup.Last; { Fetch last view }
  3093. MOV AX, ES;
  3094. OR AX, DI; { Check for nil }
  3095. JZ @@Exit; { No subviews exit }
  3096. MOV WORD PTR HoldLast[2], ES;
  3097. MOV WORD PTR HoldLast[0], DI; { Hold this last view }
  3098. LES DI, ES:[DI].TView.Next; { Move to next view }
  3099. @@LoopPoint:
  3100. CMP DI, WORD PTR HoldLast[0]; { HoldLast ofs match? }
  3101. JNZ @@2; { No match continue }
  3102. MOV AX, ES;
  3103. CMP AX, WORD PTR HoldLast[2]; { HoldLast seg match? }
  3104. JZ @@3; { Branch if last }
  3105. @@2:
  3106. PUSH WORD PTR ES:[DI].TView.Next[2]; { * Save this view }
  3107. PUSH WORD PTR ES:[DI].TView.Next[0]; { for recovery later * }
  3108. PUSH ES;
  3109. PUSH DI; { Push view to test }
  3110. MOV AX, [BP]; { Get our frame }
  3111. {$IFNDEF OS_DOS} { WIN/OS2 CODE }
  3112. AND AL, 0FEH; { Must be even }
  3113. {$ENDIF}
  3114. PUSH AX; { Push our frame }
  3115. CALL P; { Call the proc P }
  3116. POP DI; { * Recover the view }
  3117. POP ES; { we saved earlier * }
  3118. JMP @@LoopPoint; { Continue on }
  3119. @@3:
  3120. MOV AX, [BP]; { Get our frame }
  3121. {$IFNDEF OS_DOS} { WIN/OS2 CODE }
  3122. AND AL, 0FEH; { Must be even }
  3123. {$ENDIF}
  3124. PUSH AX; { Push our frame }
  3125. CALL P; { Call the proc P }
  3126. @@Exit:
  3127. END;
  3128. {$ENDIF}
  3129. {$IFDEF BIT_32} { 32 BIT CODE }
  3130. {$IFNDEF PPC_FPC} { NON FPC COMPILERS }
  3131. ASM
  3132. MOV ECX, Self; { Load self pointer }
  3133. MOV ECX, [ECX].TGroup.Last; { Fetch last view }
  3134. OR ECX, ECX; { Check for nil }
  3135. JZ @@Exit; { No subviews exit }
  3136. MOV HoldLast, ECX; { Hold last view }
  3137. MOV ECX, [ECX].TView.Next; { Fetch next pointer }
  3138. MOV EBX, P; { Fetch proc address }
  3139. @@LoopPoint:
  3140. CMP ECX, HoldLast; { Check if last view }
  3141. JZ @@2; { Branch if last view }
  3142. MOV EAX, [ECX].TView.Next; { Fetch next view }
  3143. PUSH EBX; { Save procedure address }
  3144. PUSH EAX; { Save next view }
  3145. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  3146. MOV EAX, ECX; { Use register parameter }
  3147. MOV ESI, ECX;
  3148. {$ELSE} { OTHER COMPILERS }
  3149. PUSH ECX; { Push view to do }
  3150. {$ENDIF}
  3151. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
  3152. DB $66;
  3153. DB $FF;
  3154. DB $D3; { Can't do CALL EBX }
  3155. {$ELSE}
  3156. CALL EBX; { Call the proc P }
  3157. {$ENDIF}
  3158. POP ECX; { Recover saved view }
  3159. POP EBX; { Recover procedure addr }
  3160. JMP @@LoopPoint; { Continue on }
  3161. @@2:
  3162. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILERS }
  3163. MOV EAX, ECX; { Use register parameter }
  3164. {$ELSE} { OTHER COMPILERS }
  3165. PUSH ECX; { Push view to do }
  3166. {$ENDIF}
  3167. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
  3168. DB $66;
  3169. DB $FF;
  3170. DB $D3; { Can't do CALL EBX }
  3171. {$ELSE}
  3172. CALL EBX; { Call the proc P }
  3173. {$ENDIF}
  3174. @@Exit:
  3175. END;
  3176. {$ELSE} { FPC COMPILER }
  3177. ASM
  3178. MOVL 8(%EBP), %ESI; { Self pointer }
  3179. MOVL TGroup.Last(%ESI), %ECX; { Load last view }
  3180. ORL %ECX, %ECX; { Check for nil }
  3181. JZ .L_Exit; { No subviews exit }
  3182. MOVL %ECX, HOLDLAST; { Hold last view }
  3183. MOVL TView.Next(%ECX), %ECX; { Fetch next pointer }
  3184. .L_LoopPoint:
  3185. MOVL P, %EBX; { Fetch proc address }
  3186. CMPL HOLDLAST, %ECX; { Check if last view }
  3187. JZ .L_2; { Exit if last view }
  3188. MOVL TView.Next(%ECX), %EAX; { Fetch next pointer }
  3189. PUSHL %EAX; { Save next view ptr }
  3190. PUSHL %ECX; { Push view to do }
  3191. MOVL (%EBP), %EAX;
  3192. PUSH %EAX;
  3193. CALL %EBX; { Call the procedure }
  3194. POPL %ECX; { Recover next view }
  3195. JMP .L_LoopPoint; { Redo loop }
  3196. .L_2:
  3197. PUSHL %ECX; { Push view to do }
  3198. MOVL (%EBP), %EAX;
  3199. PUSH %EAX;
  3200. CALL %EBX; { Call the procedure }
  3201. .L_Exit:
  3202. END;
  3203. {$ENDIF}
  3204. {$ENDIF}
  3205. {--TGroup-------------------------------------------------------------------}
  3206. { EndModal -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3207. {---------------------------------------------------------------------------}
  3208. PROCEDURE TGroup.EndModal (Command: Word);
  3209. BEGIN
  3210. If (State AND sfModal <> 0) Then { This view is modal }
  3211. EndState := Command Else { Set endstate }
  3212. Inherited EndModal(Command); { Call ancestor }
  3213. END;
  3214. {--TGroup-------------------------------------------------------------------}
  3215. { DisplaceBy -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB }
  3216. {---------------------------------------------------------------------------}
  3217. PROCEDURE TGroup.DisplaceBy (Dx, Dy: Integer);
  3218. VAR P: PView;
  3219. BEGIN
  3220. P := First; { Get first view }
  3221. While (P <> Nil) Do Begin
  3222. P^.DisplaceBy(Dx, Dy); { Displace subviews }
  3223. P := P^.NextView; { Next view }
  3224. End;
  3225. Inherited DisplaceBy(Dx, Dy); { Call ancestor }
  3226. END;
  3227. {--TGroup-------------------------------------------------------------------}
  3228. { SelectNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  3229. {---------------------------------------------------------------------------}
  3230. PROCEDURE TGroup.SelectNext (Forwards: Boolean);
  3231. VAR P: PView;
  3232. BEGIN
  3233. P := FindNext(Forwards); { Find next view }
  3234. If (P <> Nil) Then P^.Select; { Select view }
  3235. END;
  3236. {--TGroup-------------------------------------------------------------------}
  3237. { InsertBefore -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  3238. {---------------------------------------------------------------------------}
  3239. PROCEDURE TGroup.InsertBefore (P, Target: PView);
  3240. VAR SaveState, I: Word;
  3241. BEGIN
  3242. If (P <> Nil) AND (P^.Owner = Nil) AND { View valid }
  3243. ((Target = Nil) OR (Target^.Owner = @Self)) { Target valid }
  3244. Then Begin
  3245. If (P^.Options AND ofCenterX <> 0) Then Begin { Centre on x axis }
  3246. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3247. I := RawSize.X Else I := Size.X * FontWidth; { Calc owner x size }
  3248. If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check }
  3249. Then Begin
  3250. I := (I - P^.RawSize.X) DIV 2; { Calc view offset }
  3251. I := I - P^.RawOrigin.X; { Subtract x origin }
  3252. End Else Begin
  3253. I := (I - (P^.Size.X * FontWidth)) DIV 2; { Calc view offset }
  3254. I := I - (P^.Origin.X * FontWidth); { Subtract x origin }
  3255. End;
  3256. P^.DisplaceBy(I, 0); { Displace the view }
  3257. End;
  3258. If (P^.Options AND ofCenterY <> 0) Then Begin { Centre on y axis }
  3259. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3260. I := RawSize.Y Else I := Size.Y * FontHeight;{ Calc owner y size }
  3261. If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check }
  3262. Then Begin
  3263. I := (I - P^.RawSize.Y) DIV 2; { Calc view offset }
  3264. I := I - P^.RawOrigin.Y; { Subtract y origin }
  3265. End Else Begin
  3266. I := (I - (P^.Size.Y * FontHeight)) DIV 2; { Calc view offset }
  3267. I := I - (P^.Origin.Y * FontHeight); { Subtract y origin }
  3268. End;
  3269. P^.DisplaceBy(0, I); { Displace the view }
  3270. End;
  3271. SaveState := P^.State; { Save view state }
  3272. P^.Hide; { Make sure hidden }
  3273. InsertView(P, Target); { Insert into list }
  3274. If (SaveState AND sfVisible <> 0) Then P^.Show; { Show the view }
  3275. If (State AND sfActive <> 0) Then { Was active before }
  3276. P^.SetState(sfActive , True); { Make active again }
  3277. End;
  3278. END;
  3279. {--TGroup-------------------------------------------------------------------}
  3280. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3281. {---------------------------------------------------------------------------}
  3282. PROCEDURE TGroup.SetState (AState: Word; Enable: Boolean);
  3283. PROCEDURE DoSetState (P: PView); FAR;
  3284. BEGIN
  3285. If (P <> Nil) Then P^.SetState(AState, Enable); { Set subview state }
  3286. END;
  3287. PROCEDURE DoExpose (P: PView); FAR;
  3288. BEGIN
  3289. If (P <> Nil) Then Begin
  3290. If (P^.State AND sfVisible <> 0) Then { Check view visible }
  3291. P^.SetState(sfExposed, Enable); { Set exposed flag }
  3292. End;
  3293. END;
  3294. BEGIN
  3295. Inherited SetState(AState, Enable); { Call ancestor }
  3296. Case AState Of
  3297. sfActive, sfDragging: Begin
  3298. Lock; { Lock the view }
  3299. ForEach(@DoSetState); { Set each subview }
  3300. UnLock; { Unlock the view }
  3301. End;
  3302. sfFocused: If (Current <> Nil) Then
  3303. Current^.SetState(sfFocused, Enable); { Focus current view }
  3304. sfExposed: Begin
  3305. ForEach(@DoExpose); { Expose each subview }
  3306. End;
  3307. End;
  3308. END;
  3309. {--TGroup-------------------------------------------------------------------}
  3310. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Mar98 LdB }
  3311. {---------------------------------------------------------------------------}
  3312. PROCEDURE TGroup.GetData (Var Rec);
  3313. VAR Total: Word; P: PView;
  3314. BEGIN
  3315. Total := 0; { Clear total }
  3316. P := Last; { Start at last }
  3317. While (P <> Nil) Do Begin { Subviews exist }
  3318. P^.GetData(TByteArray(Rec)[Total]); { Get data }
  3319. Inc(Total, P^.DataSize); { Increase total }
  3320. P := P^.PrevView; { Previous view }
  3321. End;
  3322. END;
  3323. {--TGroup-------------------------------------------------------------------}
  3324. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Mar98 LdB }
  3325. {---------------------------------------------------------------------------}
  3326. PROCEDURE TGroup.SetData (Var Rec);
  3327. VAR Total: Word; P: PView;
  3328. BEGIN
  3329. Total := 0; { Clear total }
  3330. P := Last; { Start at last }
  3331. While (P <> Nil) Do Begin { Subviews exist }
  3332. P^.SetData(TByteArray(Rec)[Total]); { Get data }
  3333. Inc(Total, P^.DataSize); { Increase total }
  3334. P := P^.PrevView; { Previous view }
  3335. End;
  3336. END;
  3337. {--TGroup-------------------------------------------------------------------}
  3338. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB }
  3339. {---------------------------------------------------------------------------}
  3340. PROCEDURE TGroup.Store (Var S: TStream);
  3341. VAR Count: Integer; OwnerSave: PGroup;
  3342. PROCEDURE DoPut (P: PView); FAR;
  3343. BEGIN
  3344. S.Put(P); { Put view on stream }
  3345. END;
  3346. BEGIN
  3347. TView.Store(S); { Call view store }
  3348. OwnerSave := OwnerGroup; { Save ownergroup }
  3349. OwnerGroup := @Self; { Set as owner group }
  3350. Count := IndexOf(Last); { Subview count }
  3351. S.Write(Count, 2); { Write the count }
  3352. ForEach(@DoPut); { Put each in stream }
  3353. PutSubViewPtr(S, Current); { Current on stream }
  3354. OwnerGroup := OwnerSave; { Restore ownergroup }
  3355. END;
  3356. {--TGroup-------------------------------------------------------------------}
  3357. { EventError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3358. {---------------------------------------------------------------------------}
  3359. PROCEDURE TGroup.EventError (Var Event: TEvent);
  3360. BEGIN
  3361. If (Owner <> Nil) Then Owner^.EventError(Event); { Event error }
  3362. END;
  3363. {--TGroup-------------------------------------------------------------------}
  3364. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3365. {---------------------------------------------------------------------------}
  3366. PROCEDURE TGroup.HandleEvent (Var Event: TEvent);
  3367. FUNCTION ContainsMouse (P: PView): Boolean; FAR;
  3368. BEGIN
  3369. ContainsMouse := (P^.State AND sfVisible <> 0) { Is view visible }
  3370. AND P^.MouseInView(Event.Where); { Is point in view }
  3371. END;
  3372. PROCEDURE DoHandleEvent (P: PView); FAR;
  3373. BEGIN
  3374. If (P = Nil) OR ((P^.State AND sfDisabled <> 0) AND
  3375. (Event.What AND(PositionalEvents OR FocusedEvents) <>0 ))
  3376. Then Exit; { Invalid/disabled }
  3377. Case Phase Of
  3378. phPreProcess: If (P^.Options AND ofPreProcess = 0)
  3379. Then Exit; { Not pre processing }
  3380. phPostProcess: If (P^.Options AND ofPostProcess = 0)
  3381. Then Exit; { Not post processing }
  3382. End;
  3383. If (Event.What AND P^.EventMask <> 0) Then { View handles event }
  3384. P^.HandleEvent(Event); { Pass to view }
  3385. END;
  3386. BEGIN
  3387. Inherited HandleEvent(Event); { Call ancestor }
  3388. If (Event.What = evNothing) Then Exit; { No valid event exit }
  3389. If (Event.What AND FocusedEvents <> 0) Then Begin { Focused event }
  3390. Phase := phPreProcess; { Set pre process }
  3391. ForEach(@DoHandleEvent); { Pass to each view }
  3392. Phase := phFocused; { Set focused }
  3393. DoHandleEvent(Current); { Pass to current }
  3394. Phase := phPostProcess; { Set post process }
  3395. ForEach(@DoHandleEvent); { Pass to each }
  3396. End Else Begin
  3397. Phase := phFocused; { Set focused }
  3398. If (Event.What AND PositionalEvents <> 0) Then { Positional event }
  3399. DoHandleEvent(FirstThat(@ContainsMouse)) { Pass to first }
  3400. Else ForEach(@DoHandleEvent); { Pass to all }
  3401. End;
  3402. END;
  3403. {--TGroup-------------------------------------------------------------------}
  3404. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  3405. {---------------------------------------------------------------------------}
  3406. PROCEDURE TGroup.ChangeBounds (Var Bounds: TRect);
  3407. VAR D: TPoint;
  3408. PROCEDURE DoCalcChange (P: PView); FAR;
  3409. VAR R: TRect;
  3410. BEGIN
  3411. P^.CalcBounds(R, D); { Calc view bounds }
  3412. P^.ChangeBounds(R); { Change view bounds }
  3413. END;
  3414. BEGIN
  3415. D.X := Bounds.B.X - Bounds.A.X - Size.X; { Delta x value }
  3416. D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y; { Delta y value }
  3417. If ((D.X=0) AND (D.Y=0)) Then Begin
  3418. SetBounds(Bounds); { Set new bounds }
  3419. DrawView; { Draw the view }
  3420. End Else Begin
  3421. SetBounds(Bounds); { Set new bounds }
  3422. GetExtent(Clip); { Get new clip extents }
  3423. Lock; { Lock drawing }
  3424. ForEach(@DoCalcChange); { Change each view }
  3425. UnLock; { Unlock drawing }
  3426. End;
  3427. END;
  3428. {--TGroup-------------------------------------------------------------------}
  3429. { GetSubViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB }
  3430. {---------------------------------------------------------------------------}
  3431. PROCEDURE TGroup.GetSubViewPtr (Var S: TStream; Var P);
  3432. VAR Index, I: Word; Q: PView;
  3433. BEGIN
  3434. Index := 0; { Zero index value }
  3435. S.Read(Index, 2); { Read view index }
  3436. If (Index > 0) Then Begin { Valid index }
  3437. Q := Last; { Start on last }
  3438. For I := 1 To Index Do Q := Q^.Next; { Loop for count }
  3439. Pointer(P) := Q; { Return the view }
  3440. End Else Pointer(P) := Nil; { Return nil }
  3441. END;
  3442. {--TGroup-------------------------------------------------------------------}
  3443. { PutSubViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB }
  3444. {---------------------------------------------------------------------------}
  3445. PROCEDURE TGroup.PutSubViewPtr (Var S: TStream; P: PView);
  3446. VAR Index: Word;
  3447. BEGIN
  3448. If (P = Nil) Then Index := 0 Else { Nil view, Index = 0 }
  3449. Index := IndexOf(P); { Calc view index }
  3450. S.Write(Index, 2); { Write the index }
  3451. END;
  3452. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  3453. {***************************************************************************}
  3454. { TGroup OBJECT WIN/NT/OS2 ONLY METHODS }
  3455. {***************************************************************************}
  3456. {--TGroup-------------------------------------------------------------------}
  3457. { CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 23Mar98 LdB }
  3458. {---------------------------------------------------------------------------}
  3459. PROCEDURE TGroup.CreateWindowNow (CmdShow: Integer);
  3460. VAR P: PView;
  3461. BEGIN
  3462. Inherited CreateWindowNow (CmdShow); { Call ancestor }
  3463. P := Last; { Start on Last }
  3464. While (P <> Nil) Do Begin
  3465. If (P^.HWindow = 0) Then { No window created }
  3466. P^.CreateWindowNow(0); { Create each subview }
  3467. P := P^.PrevView; { Move to prev view }
  3468. End;
  3469. END;
  3470. {$ENDIF}
  3471. {***************************************************************************}
  3472. { TGroup OBJECT PRIVATE METHODS }
  3473. {***************************************************************************}
  3474. {--TGroup-------------------------------------------------------------------}
  3475. { IndexOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3476. {---------------------------------------------------------------------------}
  3477. FUNCTION TGroup.IndexOf (P: PView): Integer;
  3478. VAR I: Integer; Q: PView;
  3479. BEGIN
  3480. Q := Last; { Start on last view }
  3481. If (Q <> Nil) Then Begin { Subviews exist }
  3482. I := 1; { Preset value }
  3483. While (Q <> P) AND (Q^.Next <> Last) Do Begin
  3484. Q := Q^.Next; { Load next view }
  3485. Inc(I); { Increment count }
  3486. End;
  3487. If (Q <> P) Then IndexOf := 0 Else IndexOf := I; { Return index }
  3488. End Else IndexOf := 0; { Return zero }
  3489. END;
  3490. {--TGroup-------------------------------------------------------------------}
  3491. { FindNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
  3492. {---------------------------------------------------------------------------}
  3493. FUNCTION TGroup.FindNext (Forwards: Boolean): PView;
  3494. VAR P: PView;
  3495. BEGIN
  3496. FindNext := Nil; { Preset nil return }
  3497. If (Current <> Nil) Then Begin { Has current view }
  3498. P := Current; { Start on current }
  3499. Repeat
  3500. If Forwards Then P := P^.Next { Get next view }
  3501. Else P := P^.Prev; { Get prev view }
  3502. Until ((P^.State AND (sfVisible+sfDisabled) = sfVisible)
  3503. AND ((P^.Options AND ofSelectable <> 0) AND { Selectable }
  3504. (P^.GOptions AND goTabSelect <> 0))) OR { Tab selectable }
  3505. (P = Current); { Not singular select }
  3506. If (P <> Current) Then FindNext := P; { Return result }
  3507. End;
  3508. END;
  3509. {--TGroup-------------------------------------------------------------------}
  3510. { FirstMatch -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3511. {---------------------------------------------------------------------------}
  3512. FUNCTION TGroup.FirstMatch (AState: Word; AOptions: Word): PView;
  3513. FUNCTION Matches (P: PView): Boolean; FAR;
  3514. BEGIN
  3515. Matches := (P^.State AND AState = AState) AND
  3516. (P^.Options AND AOptions = AOptions); { Return match state }
  3517. END;
  3518. BEGIN
  3519. FirstMatch := FirstThat(@Matches); { Return first match }
  3520. END;
  3521. {--TGroup-------------------------------------------------------------------}
  3522. { ResetCurrent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3523. {---------------------------------------------------------------------------}
  3524. PROCEDURE TGroup.ResetCurrent;
  3525. BEGIN
  3526. SetCurrent(FirstMatch(sfVisible, ofSelectable),
  3527. NormalSelect); { Reset current view }
  3528. END;
  3529. {--TGroup-------------------------------------------------------------------}
  3530. { RemoveView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3531. {---------------------------------------------------------------------------}
  3532. PROCEDURE TGroup.RemoveView (P: PView);
  3533. VAR Q: PView;
  3534. BEGIN
  3535. If (P <> Nil) AND (Last <> Nil) Then Begin { Check view is valid }
  3536. Q := Last; { Start on last view }
  3537. While (Q^.Next <> P) AND (Q^.Next <> Last) Do
  3538. Q := Q^.Next; { Find prior view }
  3539. If (Q^.Next = P) Then Begin { View found }
  3540. If (Q^.Next <> Q) Then Begin { Not only view }
  3541. Q^.Next := P^.Next; { Rechain views }
  3542. If (P = Last) Then Last := P^.Next; { Fix if last removed }
  3543. End Else Last := Nil; { Only view }
  3544. End;
  3545. End;
  3546. END;
  3547. {--TGroup-------------------------------------------------------------------}
  3548. { InsertView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3549. {---------------------------------------------------------------------------}
  3550. PROCEDURE TGroup.InsertView (P, Target: PView);
  3551. BEGIN
  3552. If (P <> Nil) Then Begin { Check view is valid }
  3553. P^.Owner := @Self; { Views owner is us }
  3554. If (Target <> Nil) Then Begin { Valid target }
  3555. Target := Target^.Prev; { 1st part of chain }
  3556. P^.Next := Target^.Next; { 2nd part of chain }
  3557. Target^.Next := P; { Chain completed }
  3558. End Else Begin
  3559. If (Last <> Nil) Then Begin { Not first view }
  3560. P^.Next := Last^.Next; { 1st part of chain }
  3561. Last^.Next := P; { Completed chain }
  3562. End Else P^.Next := P; { 1st chain to self }
  3563. Last := P; { P is now last }
  3564. End;
  3565. End;
  3566. END;
  3567. {--TGroup-------------------------------------------------------------------}
  3568. { SetCurrent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
  3569. {---------------------------------------------------------------------------}
  3570. PROCEDURE TGroup.SetCurrent (P: PView; Mode: SelectMode);
  3571. PROCEDURE SelectView (P: PView; Enable: Boolean);
  3572. BEGIN
  3573. If (P <> Nil) Then { View is valid }
  3574. P^.SetState(sfSelected, Enable); { Select the view }
  3575. END;
  3576. PROCEDURE FocusView (P: PView; Enable: Boolean);
  3577. BEGIN
  3578. If (State AND sfFocused <> 0) AND (P <> Nil) { Check not focused }
  3579. Then P^.SetState(sfFocused, Enable); { Focus the view }
  3580. END;
  3581. BEGIN
  3582. If (Current<>P) Then Begin { Not already current }
  3583. Lock; { Stop drawing }
  3584. FocusView(Current, False); { Defocus current }
  3585. If (Mode <> EnterSelect) Then
  3586. SelectView(Current, False); { Deselect current }
  3587. If (Mode<>LeaveSelect) Then SelectView(P, True); { Select view P }
  3588. FocusView(P, True); { Focus view P }
  3589. Current := P; { Set as current view }
  3590. UnLock; { Redraw now }
  3591. End;
  3592. END;
  3593. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3594. { TFrame OBJECT METHODS }
  3595. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3596. {--TFrame-------------------------------------------------------------------}
  3597. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  3598. {---------------------------------------------------------------------------}
  3599. CONSTRUCTOR TFrame.Init (Var Bounds: TRect);
  3600. BEGIN
  3601. Inherited Init(Bounds); { Call ancestor }
  3602. GrowMode := gfGrowHiX + gfGrowHiY; { Set grow modes }
  3603. EventMask := EventMask OR evBroadcast; { See broadcasts }
  3604. END;
  3605. {--TFrame-------------------------------------------------------------------}
  3606. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  3607. {---------------------------------------------------------------------------}
  3608. FUNCTION TFrame.GetPalette: PPalette;
  3609. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  3610. CONST P: String = CFrame; { Possible huge string }
  3611. {$ELSE} { OTHER COMPILERS }
  3612. CONST P: String[Length(CFrame)] = CFrame; { Always normal string }
  3613. {$ENDIF}
  3614. BEGIN
  3615. GetPalette := @P; { Return palette }
  3616. END;
  3617. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3618. { TScrollBar OBJECT METHODS }
  3619. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3620. {---------------------------------------------------------------------------}
  3621. { TScrollBar WINDOW CLASS NAME CONSTANT }
  3622. {---------------------------------------------------------------------------}
  3623. {$IFDEF OS_WINDOWS} { WIN/NT CLASSNAME }
  3624. CONST TvScrollBarName = 'SCROLLBAR'; { Native classname }
  3625. {$ENDIF}
  3626. {$IFDEF OS_OS2} { OS2 CLASSNAME }
  3627. CONST TvScrollBarName = '#8'; { Native classname }
  3628. {$ENDIF}
  3629. {--TScrollBar---------------------------------------------------------------}
  3630. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3631. {---------------------------------------------------------------------------}
  3632. CONSTRUCTOR TScrollBar.Init (Var Bounds: TRect);
  3633. CONST VChars: TScrollChars = (#30, #31, #177, #254, #178);
  3634. HChars: TScrollChars = (#17, #16, #177, #254, #178);
  3635. BEGIN
  3636. Inherited Init(Bounds); { Call ancestor }
  3637. {$IFDEF OS_OS2} { OS2 CODE }
  3638. If (Size.X = 1) Then RawSize.X := WinQuerySysValue(
  3639. HWND_Desktop, SV_CXVScroll) Else
  3640. RawSize.Y := WinQuerySysValue(HWND_Desktop,
  3641. SV_CYHScroll); { Set approp size }
  3642. {$ENDIF}
  3643. PgStep := 1; { Page step size = 1 }
  3644. ArStep := 1; { Arrow step sizes = 1 }
  3645. If (Size.X = 1) Then Begin { Vertical scrollbar }
  3646. GrowMode := gfGrowLoX + gfGrowHiX + gfGrowHiY; { Grow vertically }
  3647. Chars := VChars; { Vertical chars }
  3648. End Else Begin { Horizontal scrollbar }
  3649. GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY; { Grow horizontal }
  3650. Chars := HChars; { Horizontal chars }
  3651. End;
  3652. END;
  3653. {--TScrollBar---------------------------------------------------------------}
  3654. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3655. {---------------------------------------------------------------------------}
  3656. { This load method will read old original TV data from a stream with the }
  3657. { scrollbar id set to zero. }
  3658. {---------------------------------------------------------------------------}
  3659. CONSTRUCTOR TScrollBar.Load (Var S: TStream);
  3660. BEGIN
  3661. Inherited Load(S); { Call ancestor }
  3662. S.Read(Value, 2); { Read current value }
  3663. S.Read(Min , 2); { Read min value }
  3664. S.Read(Max, 2); { Read max value }
  3665. S.Read(PgStep, 2); { Read page step size }
  3666. S.Read(ArStep, 2); { Read arrow step size }
  3667. S.Read(Chars, SizeOf(Chars)); { Read scroll chars }
  3668. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3669. S.Read(Id, 2); { Read id }
  3670. END;
  3671. {--TScrollBar---------------------------------------------------------------}
  3672. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3673. {---------------------------------------------------------------------------}
  3674. FUNCTION TScrollBar.GetPalette: PPalette;
  3675. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  3676. CONST P: String = CScrollBar; { Possible huge string }
  3677. {$ELSE} { OTHER COMPILERS }
  3678. CONST P: String[Length(CScrollBar)] = CScrollBar; { Always normal string }
  3679. {$ENDIF}
  3680. BEGIN
  3681. GetPalette := @P; { Return palette }
  3682. END;
  3683. {--TScrollBar---------------------------------------------------------------}
  3684. { ScrollStep -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3685. {---------------------------------------------------------------------------}
  3686. FUNCTION TScrollBar.ScrollStep (Part: Integer): Integer;
  3687. VAR Step: Integer;
  3688. BEGIN
  3689. If (Part AND $0002 = 0) Then Step := ArStep { Range step size }
  3690. Else Step := PgStep; { Page step size }
  3691. If (Part AND $0001 = 0) Then ScrollStep := -Step { Upwards move }
  3692. Else ScrollStep := Step; { Downwards move }
  3693. END;
  3694. {--TScrollBar---------------------------------------------------------------}
  3695. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  3696. {---------------------------------------------------------------------------}
  3697. PROCEDURE TScrollBar.Draw;
  3698. BEGIN
  3699. If (GOptions AND goNativeClass = 0) Then
  3700. DrawPos(GetPos); { Draw position }
  3701. END;
  3702. {--TScrollBar---------------------------------------------------------------}
  3703. { ScrollDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3704. {---------------------------------------------------------------------------}
  3705. PROCEDURE TScrollBar.ScrollDraw;
  3706. VAR P: PView;
  3707. BEGIN
  3708. If (Id <> 0) Then Begin
  3709. P := TopView; { Get topmost view }
  3710. NewMessage(P, evCommand, cmIdCommunicate, Id,
  3711. Value, @Self); { New Id style message }
  3712. End;
  3713. NewMessage(Owner, evBroadcast, cmScrollBarChanged,
  3714. Id, Value, @Self); { Old TV style message }
  3715. END;
  3716. {--TScrollBar---------------------------------------------------------------}
  3717. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3718. {---------------------------------------------------------------------------}
  3719. PROCEDURE TScrollBar.DrawBackGround;
  3720. VAR Bc: Byte;
  3721. BEGIN
  3722. If (GOptions AND goNativeClass = 0) Then Begin { Non natives draw }
  3723. Inherited DrawBackGround; { Call ancestor }
  3724. Bc := GetColor(1) AND $F0 SHR 4; { Background colour }
  3725. ClearArea(0, 0, FontWidth-1, FontHeight-1, Bc); { Clear top/left area }
  3726. BiColorRectangle(0, 0, FontWidth-1, FontHeight-1,
  3727. 15, 0, False); { Draw 3d effect }
  3728. ClearArea(RawSize.X-FontWidth+1, RawSize.Y-
  3729. FontHeight+1, RawSize.X, RawSize.Y, Bc); { Clr right/lower area }
  3730. BiColorRectangle(RawSize.X-FontWidth+1,
  3731. RawSize.Y-FontHeight+1,RawSize.X, RawSize.Y,
  3732. 15, 0, False); { Draw 3d effect }
  3733. End;
  3734. END;
  3735. {--TScrollBar---------------------------------------------------------------}
  3736. { SetValue -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
  3737. {---------------------------------------------------------------------------}
  3738. PROCEDURE TScrollBar.SetValue (AValue: Integer);
  3739. BEGIN
  3740. SetParams(AValue, Min, Max, PgStep, ArStep); { Set value }
  3741. END;
  3742. {--TScrollBar---------------------------------------------------------------}
  3743. { SetRange -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
  3744. {---------------------------------------------------------------------------}
  3745. PROCEDURE TScrollBar.SetRange (AMin, AMax: Integer);
  3746. BEGIN
  3747. SetParams(Value, AMin, AMax, PgStep, ArStep); { Set range }
  3748. END;
  3749. {--TScrollBar---------------------------------------------------------------}
  3750. { SetStep -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
  3751. {---------------------------------------------------------------------------}
  3752. PROCEDURE TScrollBar.SetStep (APgStep, AArStep: Integer);
  3753. BEGIN
  3754. SetParams(Value, Min, Max, APgStep, AArStep); { Set step sizes }
  3755. END;
  3756. {--TScrollBar---------------------------------------------------------------}
  3757. { SetParams -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 21Jul99 LdB }
  3758. {---------------------------------------------------------------------------}
  3759. PROCEDURE TScrollBar.SetParams (AValue, AMin, AMax, APgStep, AArStep: Integer);
  3760. BEGIN
  3761. If (AMax < AMin) Then AMax := AMin; { Max below min fix up }
  3762. If (AValue < AMin) Then AValue := AMin; { Value below min fix }
  3763. If (AValue > AMax) Then AValue := AMax; { Value above max fix }
  3764. If (Value <> AValue) OR (Min <> AMin) OR
  3765. (Max <> AMax) Then Begin { Something changed }
  3766. If (Min <> AMin) OR (Max <> AMax) Then Begin { Range has changed }
  3767. If (GOptions AND goNativeClass = 0) Then
  3768. ClearPos(GetPos); { Clear old position }
  3769. Min := AMin; { Set new minimum }
  3770. Max := AMax; { Set new maximum }
  3771. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  3772. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3773. (HWindow <> 0) Then
  3774. SetScrollRange(HWindow, sb_Ctl, Min, Max, { Set range }
  3775. AValue = Value); { Value=AValue redraws }
  3776. {$ENDIF}
  3777. {$IFDEF OS_OS2} { OS2 CODE }
  3778. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3779. (HWindow <> 0) AND ((Min <> 0) OR (Max <> 0))
  3780. Then Begin { Valid window }
  3781. WinSendMsg(HWindow, sbm_SetScrollBar, Value,
  3782. (LongInt(Max-1) SHL 16) OR Min); { Post the message }
  3783. End;
  3784. {$ENDIF}
  3785. { This was removed as found not needed but if you
  3786. change limits but value unchanged scrollbar is not redrawm..LdB }
  3787. {If (Value = AValue) AND (State and sfVisible <> 0)
  3788. Then ScrollDraw;} { Send message out }
  3789. End Else Begin
  3790. If (GOptions AND goNativeClass = 0) Then { Not in native mode }
  3791. ClearPos(GetPos); { Clear old position }
  3792. End;
  3793. If (Value <> AValue) Then Begin { Position moved }
  3794. Value := AValue; { Set new value }
  3795. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  3796. SetDrawMask(vdInner); { Set draw masks }
  3797. DrawView; { Redraw changed }
  3798. End;
  3799. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  3800. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3801. (HWindow <> 0) Then { Valid handle }
  3802. SetScrollPos(HWindow, sb_Ctl, Value, True); { Set scrollbar pos }
  3803. {$ENDIF}
  3804. {$IFDEF OS_OS2} { OS2 CODE }
  3805. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3806. (HWindow <> 0) Then Begin { Valid window }
  3807. WinSendMsg(HWindow, sbm_SetPos, Value, 0); { Dispatch the message }
  3808. End;
  3809. {$ENDIF}
  3810. If (State AND sfVisible <> 0) Then ScrollDraw; { Send update message }
  3811. End;
  3812. End;
  3813. PgStep := APgStep; { Hold page step }
  3814. ArStep := AArStep; { Hold arrow step }
  3815. END;
  3816. {--TScrollBar---------------------------------------------------------------}
  3817. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3818. {---------------------------------------------------------------------------}
  3819. { You can save data to the stream compatable with the old original TV by }
  3820. { temporarily turning off the ofGrafVersion making the call to this store }
  3821. { routine and resetting the ofGrafVersion flag after the call. }
  3822. {---------------------------------------------------------------------------}
  3823. PROCEDURE TScrollBar.Store (Var S: TStream);
  3824. BEGIN
  3825. TView.Store(S); { TView.Store called }
  3826. S.Write(Value, 2); { Write current value }
  3827. S.Write(Min, 2); { Write min value }
  3828. S.Write(Max, 2); { Write max value }
  3829. S.Write(PgStep, 2); { Write page step size }
  3830. S.Write(ArStep, 2); { Write arrow step size }
  3831. S.Write(Chars, SizeOf(Chars)); { Write scroll chars }
  3832. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3833. S.Write(Id, 2); { Write scrollbar id }
  3834. END;
  3835. {--TScrollBar---------------------------------------------------------------}
  3836. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3837. {---------------------------------------------------------------------------}
  3838. PROCEDURE TScrollBar.HandleEvent (Var Event: TEvent);
  3839. VAR Tracking: Boolean; I, P, S, ClickPart, Iv: Integer;
  3840. Mouse: TPoint; Extent: TRect;
  3841. FUNCTION GetPartCode: Integer;
  3842. VAR Mark, Part, J: Integer;
  3843. BEGIN
  3844. Part := -1; { Preset failure }
  3845. If Extent.Contains(Mouse) Then Begin { Contains mouse }
  3846. If (Size.X = 1) Then Begin { Vertical scrollbar }
  3847. Mark := Mouse.Y - FontHeight; { Calc position }
  3848. J := FontHeight; { Font height }
  3849. End Else Begin { Horizontal bar }
  3850. Mark := Mouse.X - FontWidth; { Calc position }
  3851. J := FontWidth; { Font width }
  3852. End;
  3853. If (Mark >= P) AND (Mark < P+J) Then { Within thumbnail }
  3854. Part := sbIndicator; { Indicator part }
  3855. If (Part <> sbIndicator) Then Begin { Not indicator part }
  3856. If (Mark < 1) Then Part := sbLeftArrow Else { Left arrow part }
  3857. If (Mark < P) Then Part := sbPageLeft Else { Page left part }
  3858. If (Mark < S) Then Part := sbPageRight Else { Page right part }
  3859. Part := sbRightArrow; { Right arrow part }
  3860. If (Size.X = 1) Then Inc(Part, 4); { Correct for vertical }
  3861. End;
  3862. End;
  3863. GetPartCode := Part; { Return part code }
  3864. END;
  3865. PROCEDURE Clicked;
  3866. BEGIN
  3867. NewMessage(Owner, evBroadcast, cmScrollBarClicked,
  3868. Id, Value, @Self); { Old TV style message }
  3869. END;
  3870. BEGIN
  3871. Inherited HandleEvent(Event); { Call ancestor }
  3872. Case Event.What Of
  3873. evNothing: Exit; { Speed up exit }
  3874. evCommand: Begin { Command event }
  3875. If (Event.Command = cmIdCommunicate) AND { Id communication }
  3876. (Event.Id = Id) AND (Event.InfoPtr <> @Self) { Targeted to us }
  3877. Then Begin
  3878. SetValue(Round(Event.Data)); { Set scrollbar value }
  3879. ClearEvent(Event); { Event was handled }
  3880. End;
  3881. End;
  3882. evKeyDown:
  3883. If (State AND sfVisible <> 0) Then Begin { Scrollbar visible }
  3884. ClickPart := sbIndicator; { Preset result }
  3885. If (Size.Y = 1) Then { Horizontal bar }
  3886. Case CtrlToArrow(Event.KeyCode) Of
  3887. kbLeft: ClickPart := sbLeftArrow; { Left one item }
  3888. kbRight: ClickPart := sbRightArrow; { Right one item }
  3889. kbCtrlLeft: ClickPart := sbPageLeft; { One page left }
  3890. kbCtrlRight: ClickPart := sbPageRight; { One page right }
  3891. kbHome: I := Min; { Move to start }
  3892. kbEnd: I := Max; { Move to end }
  3893. Else Exit; { Not a valid key }
  3894. End
  3895. Else { Vertical bar }
  3896. Case CtrlToArrow(Event.KeyCode) Of
  3897. kbUp: ClickPart := sbUpArrow; { One item up }
  3898. kbDown: ClickPart := sbDownArrow; { On item down }
  3899. kbPgUp: ClickPart := sbPageUp; { One page up }
  3900. kbPgDn: ClickPart := sbPageDown; { One page down }
  3901. kbCtrlPgUp: I := Min; { Move to top }
  3902. kbCtrlPgDn: I := Max; { Move to bottom }
  3903. Else Exit; { Not a valid key }
  3904. End;
  3905. Clicked; { Send out message }
  3906. If (ClickPart <> sbIndicator) Then
  3907. I := Value + ScrollStep(ClickPart); { Calculate position }
  3908. SetValue(I); { Set new item }
  3909. ClearEvent(Event); { Event now handled }
  3910. End;
  3911. evMouseDown: Begin { Mouse press event }
  3912. Clicked; { Scrollbar clicked }
  3913. Mouse.X := Event.Where.X - RawOrigin.X; { Localize x value }
  3914. Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value }
  3915. Extent.A.X := 0; { Zero x extent value }
  3916. Extent.A.Y := 0; { Zero y extent value }
  3917. Extent.B.X := RawSize.X; { Set extent x value }
  3918. Extent.B.Y := RawSize.Y; { set extent y value }
  3919. P := GetPos; { Current position }
  3920. S := GetSize; { Initial size }
  3921. ClickPart := GetPartCode; { Get part code }
  3922. If (ClickPart <> sbIndicator) Then Begin { Not thumb nail }
  3923. Repeat
  3924. Mouse.X := Event.Where.X-RawOrigin.X; { Localize x value }
  3925. Mouse.Y := Event.Where.Y-RawOrigin.Y; { Localize y value }
  3926. If GetPartCode = ClickPart Then
  3927. SetValue(Value+ScrollStep(ClickPart)); { Same part repeat }
  3928. Until NOT MouseEvent(Event, evMouseAuto); { Until auto done }
  3929. Clicked; { Scrollbar clicked }
  3930. End Else Begin { Thumb nail move }
  3931. Iv := Value; { Initial value }
  3932. Repeat
  3933. Mouse.X := Event.Where.X - RawOrigin.X; { Localize x value }
  3934. Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value }
  3935. Tracking := Extent.Contains(Mouse); { Check contains }
  3936. If Tracking Then Begin { Tracking mouse }
  3937. If (Size.X=1) Then
  3938. I := Mouse.Y-FontHeight Else { Calc vert position }
  3939. I := Mouse.X-FontWidth; { Calc horz position }
  3940. If (I < 0) Then I := 0; { Check underflow }
  3941. If (I > S) Then I := S; { Check overflow }
  3942. End Else I := GetPos; { Get position }
  3943. If (I <> P) Then Begin
  3944. SetValue(LongInt((LongInt(I)*(Max-Min))
  3945. +(S SHR 1)) DIV S + Min); { Set new value }
  3946. P := I; { Hold new position }
  3947. End;
  3948. Until NOT MouseEvent(Event, evMouseMove); { Until not moving }
  3949. If Tracking AND (S > 0) Then { Tracking mouse }
  3950. SetValue(LongInt((LongInt(P)*(Max-Min))+
  3951. (S SHR 1)) DIV S + Min); { Set new value }
  3952. If (Iv <> Value) Then Clicked; { Scroll has moved }
  3953. End;
  3954. ClearEvent(Event); { Clear the event }
  3955. End;
  3956. End;
  3957. END;
  3958. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  3959. {***************************************************************************}
  3960. { TScrollBar OBJECT WIN/NT/OS2 ONLY METHODS }
  3961. {***************************************************************************}
  3962. {--TScrollBar---------------------------------------------------------------}
  3963. { GetClassName -> Platforms WIN/NT/OS2 - Updated 21May98 LdB }
  3964. {---------------------------------------------------------------------------}
  3965. FUNCTION TScrollBar.GetClassName: String;
  3966. BEGIN
  3967. If UseNativeClasses Then Begin
  3968. GetClassName := TvScrollBarName; { Windows class name }
  3969. GOptions := GOptions OR goNativeClass; { Native class window }
  3970. End Else GetClassName := Inherited GetClassName; { Use standard class }
  3971. END;
  3972. {--TScrollBar---------------------------------------------------------------}
  3973. { GetClassAttr -> Platforms WIN/NT/OS2 - Updated 20May98 LdB }
  3974. {---------------------------------------------------------------------------}
  3975. FUNCTION TScrollBar.GetClassAttr: LongInt;
  3976. VAR Li: LongInt;
  3977. BEGIN
  3978. Li := Inherited GetClassAttr; { Call ancestor }
  3979. If UseNativeClasses Then Begin
  3980. If (Size.Y = 1) Then
  3981. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  3982. Li := Li OR sbs_Horz OR sbs_TopAlign Else { Horizontal scrollbar }
  3983. Li := Li OR sbs_Vert OR sbs_LeftAlign; { Vertical scollbar }
  3984. {$ENDIF}
  3985. {$IFDEF OS_OS2} { OS2 CODE }
  3986. lStyle :=lStyle OR sbs_Horz OR sbs_AutoSize { Horizontal scrollbar }
  3987. Else lStyle := lStyle OR sbs_Vert OR
  3988. sbs_AutoSize; { Vertical scollbar }
  3989. {$ENDIF}
  3990. End;
  3991. GetClassAttr := Li; { Return attributes }
  3992. END;
  3993. {--TScrollBar---------------------------------------------------------------}
  3994. { CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 22May98 LdB }
  3995. {---------------------------------------------------------------------------}
  3996. PROCEDURE TScrollBar.CreateWindowNow (CmdShow: Integer);
  3997. {$IFDEF OS_OS2} VAR Mp1, Mp2: MParam; {$ENDIF}
  3998. BEGIN
  3999. Inherited CreateWindowNow(0); { Call inherited }
  4000. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  4001. (HWindow <> 0) AND ((Min <> 0) OR (Max <> 0))
  4002. Then Begin { Scrollbar created }
  4003. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4004. SetScrollRange(HWindow, sb_Ctl, Min,Max, True); { Set scrollbar range }
  4005. SetScrollPos(HWindow, sb_Ctl, Value, True); { Set scrollbar pos }
  4006. {$ENDIF}
  4007. {$IFDEF OS_OS2} { OS2 CODE }
  4008. WinSendMsg(HWindow, sbm_SetScrollBar, Value,
  4009. (LongInt(Max-1) SHL 16) OR Min); { Post the message }
  4010. {$ENDIF}
  4011. End;
  4012. END;
  4013. {$ENDIF}
  4014. {***************************************************************************}
  4015. { TScrollBar OBJECT PRIVATE METHODS }
  4016. {***************************************************************************}
  4017. {--TScrollBar---------------------------------------------------------------}
  4018. { GetPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB }
  4019. {---------------------------------------------------------------------------}
  4020. FUNCTION TScrollBar.GetPos: Integer;
  4021. VAR R: Integer;
  4022. BEGIN
  4023. R := Max - Min; { Get full range }
  4024. If (R = 0) Then GetPos := 0 Else { Return zero }
  4025. GetPos := LongInt((LongInt(Value-Min) * GetSize)
  4026. + (R SHR 1)) DIV R; { Calc position }
  4027. END;
  4028. {--TScrollBar---------------------------------------------------------------}
  4029. { GetSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB }
  4030. {---------------------------------------------------------------------------}
  4031. FUNCTION TScrollBar.GetSize: Integer;
  4032. VAR S: Integer;
  4033. BEGIN
  4034. If (Size.X = 1) Then S := RawSize.Y-3*FontHeight+1 { Vertical bar }
  4035. Else S := RawSize.X-3*FontWidth+1; { Horizontal bar }
  4036. If (S < 1) Then S := 1; { Fix minimum size }
  4037. GetSize := S; { Return size }
  4038. END;
  4039. {--TScrollBar---------------------------------------------------------------}
  4040. { DrawPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27OctMay99 LdB }
  4041. {---------------------------------------------------------------------------}
  4042. { This could be called from a message handling event so it must check the }
  4043. { view is visible, exposed and not obstructed before drawing the thumbnail }
  4044. { square area. }
  4045. {---------------------------------------------------------------------------}
  4046. PROCEDURE TScrollBar.DrawPos (Pos: Integer);
  4047. VAR X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
  4048. BEGIN
  4049. If (State AND sfVisible <> 0) AND { View is visible }
  4050. (State AND sfExposed <> 0) AND { View is exposed }
  4051. (Max <> Min) Then Begin { View has some size }
  4052. SetViewLimits; { Set view limits }
  4053. GetViewSettings(ViewPort); { Get set viewport }
  4054. If OverlapsArea(ViewPort.X1, ViewPort.Y1,
  4055. ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
  4056. {$IFDEF OS_DOS}
  4057. HideMouseCursor; { Hide the mouse }
  4058. {$ENDIF}
  4059. X1 := 0; { Initial x position }
  4060. Y1 := 0; { Initial y position }
  4061. If (Size.X=1) Then Y1 := Pos + FontHeight { Vertical bar }
  4062. Else X1 := Pos + FontWidth; { Horizontal bar }
  4063. X2 := X1 + FontWidth - 1; { Right side point }
  4064. Y2 := Y1 + FontHeight - 1; { Lower side point }
  4065. ClearArea(X1, Y1, X2, Y2, GetColor(2) AND $0F);{ Thumbnail back }
  4066. BiColorRectangle(X1, Y1, X2, Y2, 15, 8, False);{ Draw highlight }
  4067. Y1 := (Y2 + Y1) DIV 2; { Middle of thumb }
  4068. Y2 := Y1+1; { One line down }
  4069. Inc(X1, 1); { One in off left }
  4070. Dec(X2, 1); { One in off right }
  4071. BiColorRectangle(X1, Y1, X2, Y2, 15, 8, True); { Draw line marker }
  4072. {$IFDEF OS_DOS}
  4073. ShowMouseCursor; { Show the mouse }
  4074. {$ENDIF}
  4075. End;
  4076. ReleaseViewLimits; { Release the limits }
  4077. End;
  4078. END;
  4079. {--TScrollBar---------------------------------------------------------------}
  4080. { ClearPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4081. {---------------------------------------------------------------------------}
  4082. { This could be called from a message handling event so it must check the }
  4083. { view is visible, exposed and not obstructed before clearing the old }
  4084. { thumbnail area. }
  4085. {---------------------------------------------------------------------------}
  4086. PROCEDURE TScrollBar.ClearPos (Pos: Integer);
  4087. VAR X, Y: Integer; ViewPort: ViewPortType;
  4088. BEGIN
  4089. If (State AND sfVisible <> 0) AND { View is visible }
  4090. (State AND sfExposed <> 0) Then Begin { View is exposed }
  4091. SetViewLimits; { Set view limits }
  4092. GetViewSettings(ViewPort); { Get set viewport }
  4093. If OverlapsArea(ViewPort.X1, ViewPort.Y1,
  4094. ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
  4095. {$IFDEF OS_DOS}
  4096. HideMouseCursor; { Hide the mouse }
  4097. {$ENDIF}
  4098. X := 0; { Initial x position }
  4099. Y := 0; { Initial y position }
  4100. If (Size.X=1) Then Y := Pos + FontHeight { Vertical bar }
  4101. Else X := Pos + FontWidth; { Horizontal bar }
  4102. ClearArea(X, Y, X+FontWidth-1, Y+FontHeight-1,
  4103. GetColor(1) AND $F0 SHR 4); { Clear the area }
  4104. {$IFDEF OS_DOS}
  4105. ShowMouseCursor; { Show the mouse }
  4106. {$ENDIF}
  4107. End;
  4108. ReleaseViewLimits; { Release the limits }
  4109. End;
  4110. END;
  4111. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4112. { TScroller OBJECT METHODS }
  4113. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4114. {--TScroller----------------------------------------------------------------}
  4115. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4116. {---------------------------------------------------------------------------}
  4117. CONSTRUCTOR TScroller.Init (Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  4118. BEGIN
  4119. Inherited Init(Bounds); { Call ancestor }
  4120. Options := Options OR ofSelectable; { View is selectable }
  4121. EventMask := EventMask OR evBroadcast; { See broadcasts }
  4122. HScrollBar := AHScrollBar; { Hold horz scrollbar }
  4123. VScrollBar := AVScrollBar; { Hold vert scrollbar }
  4124. END;
  4125. {--TScroller----------------------------------------------------------------}
  4126. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4127. {---------------------------------------------------------------------------}
  4128. { This load method will read old original TV data from a stream as well }
  4129. { as the new graphical scroller views. }
  4130. {---------------------------------------------------------------------------}
  4131. CONSTRUCTOR TScroller.Load (Var S: TStream);
  4132. BEGIN
  4133. Inherited Load(S); { Call ancestor }
  4134. GetPeerViewPtr(S, HScrollBar); { Load horz scrollbar }
  4135. GetPeerViewPtr(S, VScrollBar); { Load vert scrollbar }
  4136. S.Read(Delta.X, 2); { Read delta x value }
  4137. S.Read(Delta.Y, 2); { Read delta y value }
  4138. S.Read(Limit.X, 2); { Read limit x value }
  4139. S.Read(Limit.Y, 2); { Read limit y value }
  4140. END;
  4141. {--TScroller----------------------------------------------------------------}
  4142. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4143. {---------------------------------------------------------------------------}
  4144. FUNCTION TScroller.GetPalette: PPalette;
  4145. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  4146. CONST P: String = CScroller; { Possible huge string }
  4147. {$ELSE} { OTHER COMPILERS }
  4148. CONST P: String[Length(CScroller)] = CScroller; { Always normal string }
  4149. {$ENDIF}
  4150. BEGIN
  4151. GetPalette := @P; { Scroller palette }
  4152. END;
  4153. {--TScroller----------------------------------------------------------------}
  4154. { ScrollTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4155. {---------------------------------------------------------------------------}
  4156. PROCEDURE TScroller.ScrollTo (X, Y: Integer);
  4157. BEGIN
  4158. Inc(DrawLock); { Set draw lock }
  4159. If (HScrollBar<>Nil) Then HScrollBar^.SetValue(X); { Set horz scrollbar }
  4160. If (VScrollBar<>Nil) Then VScrollBar^.SetValue(Y); { Set vert scrollbar }
  4161. Dec(DrawLock); { Release draw lock }
  4162. CheckDraw; { Check need to draw }
  4163. END;
  4164. {--TScroller----------------------------------------------------------------}
  4165. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4166. {---------------------------------------------------------------------------}
  4167. PROCEDURE TScroller.SetState (AState: Word; Enable: Boolean);
  4168. PROCEDURE ShowSBar (SBar: PScrollBar);
  4169. BEGIN
  4170. If (SBar <> Nil) Then { Scroll bar valid }
  4171. If GetState(sfActive + sfSelected) Then { Check state masks }
  4172. SBar^.Show Else SBar^.Hide; { Draw appropriately }
  4173. END;
  4174. BEGIN
  4175. Inherited SetState(AState, Enable); { Call ancestor }
  4176. If (AState AND (sfActive + sfSelected) <> 0) { Active/select change }
  4177. Then Begin
  4178. ShowSBar(HScrollBar); { Redraw horz scrollbar }
  4179. ShowSBar(VScrollBar); { Redraw vert scrollbar }
  4180. End;
  4181. END;
  4182. {--TScroller----------------------------------------------------------------}
  4183. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4184. {---------------------------------------------------------------------------}
  4185. { The scroller is saved to the stream compatable with the old TV object. }
  4186. {---------------------------------------------------------------------------}
  4187. PROCEDURE TScroller.Store (Var S: TStream);
  4188. BEGIN
  4189. TView.Store(S); { Call TView explicitly }
  4190. PutPeerViewPtr(S, HScrollBar); { Store horz bar }
  4191. PutPeerViewPtr(S, VScrollBar); { Store vert bar }
  4192. S.Write(Delta.X, 2); { Write delta x value }
  4193. S.Write(Delta.Y, 2); { Write delta y value }
  4194. S.Write(Limit.X, 2); { Write limit x value }
  4195. S.Write(Limit.Y, 2); { Write limit y value }
  4196. END;
  4197. {--TScroller----------------------------------------------------------------}
  4198. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4199. {---------------------------------------------------------------------------}
  4200. PROCEDURE TScroller.HandleEvent (Var Event: TEvent);
  4201. BEGIN
  4202. Inherited HandleEvent(Event); { Call ancestor }
  4203. If (Event.What = evBroadcast) AND
  4204. (Event.Command = cmScrollBarChanged) AND { Scroll bar change }
  4205. ((Event.InfoPtr = HScrollBar) OR { Our scrollbar? }
  4206. (Event.InfoPtr = VScrollBar)) Then ScrollDraw; { Redraw scroller }
  4207. END;
  4208. {--TScroller----------------------------------------------------------------}
  4209. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4210. {---------------------------------------------------------------------------}
  4211. PROCEDURE TScroller.ChangeBounds (Var Bounds: TRect);
  4212. BEGIN
  4213. SetBounds(Bounds); { Set new bounds }
  4214. Inc(DrawLock); { Set draw lock }
  4215. SetLimit(Limit.X, Limit.Y); { Adjust limits }
  4216. Dec(DrawLock); { Release draw lock }
  4217. DrawFlag := False; { Clear draw flag }
  4218. DrawView; { Redraw now }
  4219. END;
  4220. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4221. { TListViewer OBJECT METHODS }
  4222. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4223. CONST TvListViewerName = 'LISTBOX'; { Native name }
  4224. {--TListViewer--------------------------------------------------------------}
  4225. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4226. {---------------------------------------------------------------------------}
  4227. CONSTRUCTOR TListViewer.Init (Var Bounds: TRect; ANumCols: Word; AHScrollBar,
  4228. AVScrollBar: PScrollBar);
  4229. VAR ArStep, PgStep: Integer;
  4230. BEGIN
  4231. Inherited Init(Bounds); { Call ancestor }
  4232. Options := Options OR (ofFirstClick+ofSelectable); { Set options }
  4233. EventMask := EventMask OR evBroadcast; { Set event mask }
  4234. NumCols := ANumCols; { Hold column number }
  4235. If (AVScrollBar <> Nil) Then Begin { Chk vert scrollbar }
  4236. If (NumCols = 1) Then Begin { Only one column }
  4237. PgStep := Size.Y -1; { Set page size }
  4238. ArStep := 1; { Set step size }
  4239. End Else Begin { Multiple columns }
  4240. PgStep := Size.Y * NumCols; { Set page size }
  4241. ArStep := Size.Y; { Set step size }
  4242. End;
  4243. AVScrollBar^.SetStep(PgStep, ArStep); { Set scroll values }
  4244. End;
  4245. If (AHScrollBar <> Nil) Then
  4246. AHScrollBar^.SetStep(Size.X DIV NumCols, 1); { Set step size }
  4247. HScrollBar := AHScrollBar; { Horz scrollbar held }
  4248. VScrollBar := AVScrollBar; { Vert scrollbar held }
  4249. GOptions := GOptions OR goDrawFocus; { Draw focus changes }
  4250. END;
  4251. {--TListViewer--------------------------------------------------------------}
  4252. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4253. {---------------------------------------------------------------------------}
  4254. CONSTRUCTOR TListViewer.Load (Var S: TStream);
  4255. BEGIN
  4256. Inherited Load(S); { Call ancestor }
  4257. GetPeerViewPtr(S, HScrollBar); { Get horz scrollbar }
  4258. GetPeerViewPtr(S, VScrollBar); { Get vert scrollbar }
  4259. S.Read(NumCols, 2); { Read column number }
  4260. S.Read(TopItem, 2); { Read top most item }
  4261. S.Read(Focused, 2); { Read focused item }
  4262. S.Read(Range, 2); { Read listview range }
  4263. END;
  4264. {--TListViewer--------------------------------------------------------------}
  4265. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4266. {---------------------------------------------------------------------------}
  4267. FUNCTION TListViewer.GetPalette: PPalette;
  4268. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  4269. CONST P: String = CListViewer; { Possible huge string }
  4270. {$ELSE} { OTHER COMPILERS }
  4271. CONST P: String[Length(CListViewer)] = CListViewer; { Always normal string }
  4272. {$ENDIF}
  4273. BEGIN
  4274. GetPalette := @P; { Return palette }
  4275. END;
  4276. {--TListViewer--------------------------------------------------------------}
  4277. { IsSelected -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4278. {---------------------------------------------------------------------------}
  4279. FUNCTION TListViewer.IsSelected (Item: Integer): Boolean;
  4280. BEGIN
  4281. If (Item = Focused) Then IsSelected := True Else
  4282. IsSelected := False; { Selected item }
  4283. END;
  4284. {--TListViewer--------------------------------------------------------------}
  4285. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4286. {---------------------------------------------------------------------------}
  4287. FUNCTION TListViewer.GetText (Item: Integer; MaxLen: Integer): String;
  4288. BEGIN { Abstract method }
  4289. END;
  4290. {--TListViewer--------------------------------------------------------------}
  4291. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4292. {---------------------------------------------------------------------------}
  4293. PROCEDURE TListViewer.DrawBackGround;
  4294. VAR SCOff: Byte; I, J, ColWidth, Item, Indent, CurCol: Integer; Color: Word;
  4295. Text: String; B: TDrawBuffer;
  4296. {$IFDEF OS_WINDOWS} S: String; {$ENDIF} { WIN/NT CODE }
  4297. BEGIN
  4298. ColWidth := Size.X DIV NumCols + 1; { Calc column width }
  4299. If (HScrollBar = Nil) Then Indent := 0 Else { Set indent to zero }
  4300. Indent := HScrollBar^.Value; { Fetch any indent }
  4301. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4302. If (GOptions AND goNativeClass <> 0) Then Begin { Native class mode }
  4303. If (Range <> SendMessage(HWindow, lb_GetCount,
  4304. 0, 0)) Then SendMessage(HWindow,lb_ResetContent, { If ranges differ }
  4305. 0, 0); { Clear all strings }
  4306. For I := 1 To Range Do Begin { For each item }
  4307. J := SendMessage(HWindow, lb_GetText, 0,
  4308. LongInt(@S[1])); { Get current text }
  4309. If (J <> lb_Err) Then Begin { Check for error }
  4310. {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
  4311. SetLength(S, J); { Set string length }
  4312. {$ELSE} { OTHER COMPILERS }
  4313. S[0] := Chr(J); { Set string legth }
  4314. {$ENDIF}
  4315. End Else S := ''; { Error no string }
  4316. Text := GetText(I-1, ColWidth + Indent); { Fetch text }
  4317. Text := Copy(Text, Indent, ColWidth) + #0; { Select right bit }
  4318. If (S <> Text) Then Begin { Strings differ }
  4319. If (J <> lb_Err) Then SendMessage(HWindow,
  4320. lb_DeleteString, I-1, 0); { Delete current string }
  4321. SendMessage(HWindow, lb_InsertString, I-1,
  4322. LongInt(@Text[1])); { Set string in list }
  4323. End;
  4324. End;
  4325. If (Options AND ofSelectable <> 0) Then
  4326. SendMessage(HWindow, lb_SetCurSel, Focused, 0); { Focus selected item }
  4327. TopItem := SendMessage(HWindow, lb_GetTopIndex,
  4328. 0, 0); { Synchronize }
  4329. UpdateWindow(HWindow); { Redraw new strings }
  4330. Exit; { Native mode is done }
  4331. End;
  4332. {$ENDIF}
  4333. Inherited DrawBackGround; { Call ancestor }
  4334. Color := GetColor(2); { Normal colour }
  4335. For I := 0 To Size.Y - 1 Do Begin { For each line }
  4336. For J := 0 To NumCols-1 Do Begin { For each column }
  4337. Item := J*Size.Y + I + TopItem; { Process this item }
  4338. CurCol := J*ColWidth; { Current column }
  4339. MoveChar(B[CurCol], ' ', Color, ColWidth); { Clear buffer }
  4340. If (Item < Range) Then Begin { Within text range }
  4341. Text := GetText(Item, ColWidth + Indent); { Fetch text }
  4342. Text := Copy(Text, Indent, ColWidth); { Select right bit }
  4343. MoveStr(B[CurCol+1], Text, Color); { Transfer to buffer }
  4344. If ShowMarkers Then Begin
  4345. WordRec(B[CurCol]).Lo := Byte(
  4346. SpecialChars[SCOff]); { Set marker character }
  4347. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(
  4348. SpecialChars[SCOff+1]); { Set marker character }
  4349. End;
  4350. End;
  4351. MoveChar(B[CurCol+ColWidth-1], #179,
  4352. GetColor(5), 1); { Put centre line marker }
  4353. End;
  4354. WriteLine(0, I, Size.X, 1, B); { Write line to screen }
  4355. End;
  4356. END;
  4357. {--TListViewer--------------------------------------------------------------}
  4358. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4359. {---------------------------------------------------------------------------}
  4360. PROCEDURE TListViewer.DrawFocus;
  4361. VAR DrawIt: Boolean; I, J, Item, CurCol, ColWidth: Integer;
  4362. Color: Word;
  4363. Indent: Integer;
  4364. B: TDrawBuffer;
  4365. Text,S: String;
  4366. SCOff: Byte;
  4367. BEGIN
  4368. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4369. If (GOptions AND goNativeClass <> 0) Then Exit; { Native class exits }
  4370. {$ENDIF}
  4371. ColWidth := Size.X DIV NumCols + 1; { Calc column width }
  4372. If (HScrollBar = Nil) Then Indent := 0 Else { Set indent to zero }
  4373. Indent := HScrollBar^.Value; { Fetch any indent }
  4374. For I := 0 To Size.Y - 1 Do Begin { For each line }
  4375. For J := 0 To NumCols-1 Do Begin { For each column }
  4376. Item := J*Size.Y + I + TopItem; { Process this item }
  4377. CurCol := J*ColWidth; { Current column }
  4378. DrawIt := False; { Preset false }
  4379. If (State AND (sfSelected + sfActive) =
  4380. (sfSelected + sfActive)) AND (Focused = Item) { Focused item }
  4381. AND (Range > 0) Then Begin
  4382. DrawIt := True; { Draw this item }
  4383. Color := GetColor(3); { Focused colour }
  4384. SetCursor(CurCol+1,I); { Set the cursor }
  4385. SCOff := 0; { Zero colour offset }
  4386. End Else If (Item < Range) AND IsSelected(Item){ Selected item }
  4387. Then Begin
  4388. DrawIt := True; { Draw this item }
  4389. If (State AND sfActive <> 0) Then
  4390. Color := GetColor(4) Else { Selected colour }
  4391. Color := GetColor(2); { Remove focus }
  4392. SCOff := 2; { Colour offset=2 }
  4393. End;
  4394. If DrawIt Then Begin { We are drawing item }
  4395. ClearArea(0, I*FontHeight, ColWidth*FontWidth,
  4396. (I+1)*FontHeight-1, Color AND $F0 SHR 4); { Draw the bar }
  4397. MoveChar(B[CurCol], ' ', Color, ColWidth);
  4398. if Item < Range then begin
  4399. Text := GetText(Item, ColWidth + Indent);
  4400. Text := Copy(Text,Indent,ColWidth);
  4401. MoveStr(B[CurCol+1], Text, Color);
  4402. if ShowMarkers then begin
  4403. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  4404. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  4405. end;
  4406. end;
  4407. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  4408. WriteLine(0, I, Size.X, 1, B);
  4409. End;
  4410. End;
  4411. End;
  4412. END;
  4413. {--TListViewer--------------------------------------------------------------}
  4414. { FocusItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4415. {---------------------------------------------------------------------------}
  4416. PROCEDURE TListViewer.FocusItem (Item: Integer);
  4417. BEGIN
  4418. Focused := Item; { Set focus to item }
  4419. If (VScrollBar <> Nil) Then
  4420. VScrollBar^.SetValue(Item); { Scrollbar to value }
  4421. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4422. If (GOptions AND goNativeClass <> 0) Then Begin { Native class mode }
  4423. If (HWindow <> 0) Then Begin { Check window valid }
  4424. If (Options AND ofSelectable <> 0) Then
  4425. SendMessage(HWindow, lb_SetCurSel, Focused, 0);{ Focus selected item }
  4426. TopItem := SendMessage(HWindow, lb_GetTopIndex,
  4427. 0, 0); { Synchronize }
  4428. End;
  4429. Exit; { Native mode done }
  4430. End;
  4431. {$ENDIF}
  4432. If (Item < TopItem) Then { Item above top item }
  4433. If (NumCols = 1) Then TopItem := Item { Set top item }
  4434. Else TopItem := Item - Item MOD Size.Y { Set top item }
  4435. Else If (Item >= TopItem + (Size.Y*NumCols)) Then { Item below bottom }
  4436. If (NumCols = 1) Then TopItem := Item-Size.Y+1 { Set new top item }
  4437. Else TopItem := Item - Item MOD Size.Y -
  4438. (Size.Y*(NumCols-1)); { Set new top item }
  4439. END;
  4440. {--TListViewer--------------------------------------------------------------}
  4441. { SetTopItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Aug99 LdB }
  4442. {---------------------------------------------------------------------------}
  4443. PROCEDURE TListViewer.SetTopItem (Item: Integer);
  4444. BEGIN
  4445. TopItem := Item; { Set the top item }
  4446. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4447. If (GOptions AND goNativeClass <> 0) AND { Native class mode }
  4448. (HWindow <> 0) Then { Window valid }
  4449. SendMessage(HWindow, lb_SetTopIndex, Item, 0); { Synchronize }
  4450. {$ENDIF}
  4451. END;
  4452. {--TListViewer--------------------------------------------------------------}
  4453. { SetRange -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4454. {---------------------------------------------------------------------------}
  4455. PROCEDURE TListViewer.SetRange (ARange: Integer);
  4456. BEGIN
  4457. Range := ARange; { Set new range }
  4458. If (VScrollBar <> Nil) Then Begin { Vertical scrollbar }
  4459. If (Focused > ARange) Then Focused := 0; { Clear focused }
  4460. VScrollBar^.SetParams(Focused, 0, ARange - 1,
  4461. VScrollBar^.PgStep, VScrollBar^.ArStep); { Set parameters }
  4462. End;
  4463. END;
  4464. {--TListViewer--------------------------------------------------------------}
  4465. { SelectItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4466. {---------------------------------------------------------------------------}
  4467. PROCEDURE TListViewer.SelectItem (Item: Integer);
  4468. BEGIN
  4469. Message(Owner, evBroadcast, cmListItemSelected,
  4470. @Self); { Send message }
  4471. END;
  4472. {--TListViewer--------------------------------------------------------------}
  4473. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4474. {---------------------------------------------------------------------------}
  4475. PROCEDURE TListViewer.SetState (AState: Word; Enable: Boolean);
  4476. PROCEDURE ShowSBar(SBar: PScrollBar);
  4477. BEGIN
  4478. If (SBar <> Nil) Then { Valid scrollbar }
  4479. If GetState(sfActive) AND GetState(sfVisible) { Check states }
  4480. Then SBar^.Show Else SBar^.Hide; { Show or hide }
  4481. END;
  4482. PROCEDURE LoseFocus;
  4483. VAR Cs: Integer;
  4484. BEGIN
  4485. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  4486. Cs := State; { Hold current state }
  4487. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  4488. State := State AND (sfActive XOR $FFFF); { Weird bug!!! }
  4489. {$ELSE} { OTHER COMPILERS }
  4490. State := State AND NOT sfActive; { Must remove focus }
  4491. {$ENDIF}
  4492. SetDrawmask(vdFocus); { Set focus mask }
  4493. DrawView; { Remove focus box }
  4494. State := Cs; { Reset state masks }
  4495. End;
  4496. END;
  4497. BEGIN
  4498. Inherited SetState(AState, Enable); { Call ancestor }
  4499. If (AState AND sfFocused <> 0) Then { Focus change }
  4500. If NOT Enable Then LoseFocus; { Redraw drop focus }
  4501. If (AState AND (sfSelected + sfActive + sfVisible) <> 0)
  4502. Then Begin { Check states }
  4503. SetDrawMask(vdFocus);
  4504. DrawView; { Draw the view }
  4505. ShowSBar(HScrollBar); { Show horz scrollbar }
  4506. ShowSBar(VScrollBar); { Show vert scrollbar }
  4507. End;
  4508. END;
  4509. {--TListViewer--------------------------------------------------------------}
  4510. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4511. {---------------------------------------------------------------------------}
  4512. PROCEDURE TListViewer.Store (Var S: TStream);
  4513. BEGIN
  4514. TView.Store(S); { Call TView explicitly }
  4515. PutPeerViewPtr(S, HScrollBar); { Put horz scrollbar }
  4516. PutPeerViewPtr(S, VScrollBar); { Put vert scrollbar }
  4517. S.Write(NumCols, 2); { Write column number }
  4518. S.Write(TopItem, 2); { Write top most item }
  4519. S.Write(Focused, 2); { Write focused item }
  4520. S.Write(Range, 2); { Write listview range }
  4521. END;
  4522. {--TListViewer--------------------------------------------------------------}
  4523. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4524. {---------------------------------------------------------------------------}
  4525. PROCEDURE TListViewer.HandleEvent (Var Event: TEvent);
  4526. CONST MouseAutosToSkip = 4;
  4527. VAR Oi, Ni: Integer; Ct, Cw: Word; Mouse: TPoint;
  4528. PROCEDURE MoveFocus (Req: Integer);
  4529. VAR Ti, Cs: Integer;
  4530. BEGIN
  4531. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  4532. Ti := TopItem; { Hold top item }
  4533. Cs := State; { Hold current state }
  4534. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  4535. State := State AND (sfActive XOR $FFFF); { Weird bug!!!! }
  4536. {$ELSE} { OTHER COMPILERS }
  4537. State := State AND NOT sfActive; { Must remove focus }
  4538. {$ENDIF}
  4539. SetDrawmask(vdFocus); { Set focus mask }
  4540. DrawView; { Remove focus box }
  4541. State := Cs; { Reset state masks }
  4542. End;
  4543. FocusItemNum(Req); { Focus req item }
  4544. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  4545. If (Ti <> TopItem) Then DrawView Else Begin { Redraw all view }
  4546. SetDrawmask(vdFocus); { Set focus mask }
  4547. DrawView; { Redraw focus box }
  4548. End;
  4549. End;
  4550. END;
  4551. BEGIN
  4552. Inherited HandleEvent(Event); { Call ancestor }
  4553. Case Event.What Of
  4554. evNothing: Exit; { Speed up exit }
  4555. evKeyDown: Begin { Key down event }
  4556. If (Event.CharCode = ' ') AND (Focused < Range){ Spacebar select }
  4557. Then Begin
  4558. SelectItem(Focused); { Select focused item }
  4559. Ni := Focused; { Hold new item }
  4560. End Else Case CtrlToArrow(Event.KeyCode) Of
  4561. kbUp: Ni := Focused - 1; { One item up }
  4562. kbDown: Ni := Focused + 1; { One item down }
  4563. kbRight: If (NumCols > 1) Then
  4564. Ni := Focused + Size.Y Else Exit; { One column right }
  4565. kbLeft: If (NumCols > 1) Then
  4566. Ni := Focused - Size.Y Else Exit; { One column left }
  4567. kbPgDn: Ni := Focused + Size.Y * NumCols; { One page down }
  4568. kbPgUp: Ni := Focused - Size.Y * NumCols; { One page up }
  4569. kbHome: Ni := TopItem; { Move to top }
  4570. kbEnd: Ni := TopItem + (Size.Y*NumCols)-1; { Move to bottom }
  4571. kbCtrlPgDn: Ni := Range - 1; { Move to last item }
  4572. kbCtrlPgUp: Ni := 0; { Move to first item }
  4573. Else Exit;
  4574. End;
  4575. MoveFocus(Ni); { Move the focus }
  4576. ClearEvent(Event); { Event was handled }
  4577. End;
  4578. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4579. evCommand: If (Event.Command = cmNotify) Then { Notify command }
  4580. Begin
  4581. FocusItem(Round(Event.Data)); { Focus the item }
  4582. SelectItem(Focused); { Select the item }
  4583. ClearEvent(Event); { Event was handled }
  4584. End Else Exit; { Not handled command }
  4585. {$ENDIF}
  4586. evBroadcast: Begin { Broadcast event }
  4587. If (Options AND ofSelectable <> 0) Then { View is selectable }
  4588. If (Event.Command = cmScrollBarClicked) AND { Scrollbar click }
  4589. ((Event.InfoPtr = HScrollBar) OR
  4590. (Event.InfoPtr = VScrollBar)) Then Select { Scrollbar selects us }
  4591. Else If (Event.Command = cmScrollBarChanged) { Scrollbar changed }
  4592. Then Begin
  4593. If (VScrollBar = Event.InfoPtr) Then Begin
  4594. MoveFocus(VScrollBar^.Value); { Focus us to item }
  4595. End Else If (HScrollBar = Event.InfoPtr)
  4596. Then DrawView; { Redraw the view }
  4597. End;
  4598. End;
  4599. evMouseDown: Begin { Mouse down event }
  4600. Cw := Size.X DIV NumCols + 1; { Column width }
  4601. Oi := Focused; { Hold focused item }
  4602. MakeLocal(Event.Where, Mouse); { Localize mouse }
  4603. If MouseInView(Event.Where) Then Ni := Mouse.Y
  4604. + (Size.Y*(Mouse.X DIV Cw))+TopItem { Calc item to focus }
  4605. Else Ni := Oi; { Focus old item }
  4606. Ct := 0; { Clear count value }
  4607. Repeat
  4608. If (Ni <> Oi) Then Begin { Item is different }
  4609. MoveFocus(Ni); { Move the focus }
  4610. Oi := Focused; { Hold as focused item }
  4611. End;
  4612. MakeLocal(Event.Where, Mouse); { Localize mouse }
  4613. If NOT MouseInView(Event.Where) Then Begin
  4614. If (Event.What = evMouseAuto) Then Inc(Ct);{ Inc auto count }
  4615. If (Ct = MouseAutosToSkip) Then Begin
  4616. Ct := 0; { Reset count }
  4617. If (NumCols = 1) Then Begin { Only one column }
  4618. If (Mouse.Y < 0) Then Ni := Focused-1; { Move up one item }
  4619. If (Mouse.Y >= Size.Y) Then
  4620. Ni := Focused+1; { Move down one item }
  4621. End Else Begin { Multiple columns }
  4622. If (Mouse.X < 0) Then { Mouse x below zero }
  4623. Ni := Focused-Size.Y; { Move down 1 column }
  4624. If (Mouse.X >= Size.X) Then { Mouse x above width }
  4625. Ni := Focused+Size.Y; { Move up 1 column }
  4626. If (Mouse.Y < 0) Then { Mouse y below zero }
  4627. Ni := Focused-Focused MOD Size.Y; { Move up one item }
  4628. If (Mouse.Y > Size.Y) Then { Mouse y above height }
  4629. Ni := Focused-Focused MOD
  4630. Size.Y+Size.Y-1; { Move down one item }
  4631. End;
  4632. End;
  4633. End Else Ni := Mouse.Y + (Size.Y*(Mouse.X
  4634. DIV Cw))+TopItem; { New item to focus }
  4635. Until NOT MouseEvent(Event, evMouseMove +
  4636. evMouseAuto); { Mouse stopped }
  4637. If (Oi <> Ni) Then MoveFocus(Ni); { Focus moved again }
  4638. If (Event.Double AND (Range > Focused)) Then
  4639. SelectItem(Focused); { Select the item }
  4640. ClearEvent(Event); { Event was handled }
  4641. End;
  4642. End;
  4643. END;
  4644. {--TListViewer--------------------------------------------------------------}
  4645. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4646. {---------------------------------------------------------------------------}
  4647. PROCEDURE TListViewer.ChangeBounds (Var Bounds: TRect);
  4648. BEGIN
  4649. Inherited ChangeBounds(Bounds); { Call ancestor }
  4650. If (HScrollBar <> Nil) Then { Valid horz scrollbar }
  4651. HScrollBar^.SetStep(Size.X DIV NumCols,
  4652. HScrollBar^.ArStep); { Update horz bar }
  4653. If (VScrollBar <> Nil) Then { Valid vert scrollbar }
  4654. VScrollBar^.SetStep(Size.Y * NumCols,
  4655. VScrollBar^.ArStep); { Update vert bar }
  4656. END;
  4657. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4658. {***************************************************************************}
  4659. { TListViewer OBJECT WIN/NT ONLY METHODS }
  4660. {***************************************************************************}
  4661. {--TListViewer--------------------------------------------------------------}
  4662. { GetNotifyCmd -> Platforms WIN/NT/OS2 - Updated 06Aug99 LdB }
  4663. {---------------------------------------------------------------------------}
  4664. FUNCTION TListViewer.GetNotifyCmd: LongInt;
  4665. BEGIN
  4666. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4667. GetNotifyCmd := lb_GetCurSel; { Listbox get selection }
  4668. {$ENDIF}
  4669. {$IFDEF OS_OS2} { OS2 CODE }
  4670. GetNotifyCmd := lm_QuerySelection; { Listbox get selection }
  4671. {$ENDIF}
  4672. END;
  4673. {--TListViewer--------------------------------------------------------------}
  4674. { GetClassName -> Platforms WIN/NT - Updated 27Oct99 LdB }
  4675. {---------------------------------------------------------------------------}
  4676. FUNCTION TListViewer.GetClassName: String;
  4677. BEGIN
  4678. If UseNativeClasses Then Begin { Use native classes }
  4679. GetClassName := TvListViewerName; { Windows class name }
  4680. GOptions := GOptions OR goNativeClass; { Native class window }
  4681. End Else GetClassName := Inherited GetClassName; { Use standard class }
  4682. END;
  4683. {--TListViewer--------------------------------------------------------------}
  4684. { GetClassAttr -> Platforms WIN/NT - Updated 27Oct99 LdB }
  4685. {---------------------------------------------------------------------------}
  4686. FUNCTION TListViewer.GetClassAttr: LongInt;
  4687. VAR Li: LongInt;
  4688. BEGIN
  4689. Li := Inherited GetClassAttr; { Call ancestor }
  4690. Li := Li OR lbs_HasStrings OR lbs_Notify; { Set has strings mask }
  4691. If (NumCols > 1) Then
  4692. Li := Li OR lbs_MultiColumn; { Has multiple columns }
  4693. Li := Li OR LBS_NOINTEGRALHEIGHT ;
  4694. GetClassAttr := Li; { Return attributes }
  4695. END;
  4696. {--TListViewer--------------------------------------------------------------}
  4697. { CreateWindowNow -> Platforms WIN/NT - Updated 27Oct99 LdB }
  4698. {---------------------------------------------------------------------------}
  4699. PROCEDURE TListViewer.CreateWindowNow (CmdShow: Integer);
  4700. BEGIN
  4701. Inherited CreateWindowNow(CmdShow); { Call ancestor }
  4702. DrawView; { Redraw the view }
  4703. END;
  4704. {$ENDIF}
  4705. {***************************************************************************}
  4706. { TListViewer OBJECT PRIVATE METHODS }
  4707. {***************************************************************************}
  4708. {--TListViewer--------------------------------------------------------------}
  4709. { FocusItemNum -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4710. {---------------------------------------------------------------------------}
  4711. PROCEDURE TListViewer.FocusItemNum (Item: Integer);
  4712. BEGIN
  4713. If (Item < 0) Then Item := 0 Else { Restrain underflow }
  4714. If (Item >= Range) AND (Range > 0) Then
  4715. Item := Range-1; { Restrain overflow }
  4716. If (Range <> 0) Then FocusItem(Item); { Set focus value }
  4717. END;
  4718. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4719. { TWindow OBJECT METHODS }
  4720. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4721. {--TWindow------------------------------------------------------------------}
  4722. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4723. {---------------------------------------------------------------------------}
  4724. CONSTRUCTOR TWindow.Init (Var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
  4725. BEGIN
  4726. Inherited Init(Bounds); { Call ancestor }
  4727. State := State OR sfShadow; { View is shadowed }
  4728. Options := Options OR (ofSelectable+ofTopSelect); { Select options set }
  4729. GrowMode := gfGrowAll + gfGrowRel; { Set growmodes }
  4730. Flags := wfMove + wfGrow + wfClose + wfZoom; { Set flags }
  4731. Title := NewStr(ATitle); { Hold title }
  4732. Number := ANumber; { Hold number }
  4733. Palette := wpBlueWindow; { Default palette }
  4734. GOptions := GOptions OR goThickFramed; { Thick frame }
  4735. GOptions := GOptions OR goTitled; { Title window }
  4736. GOptions := GOptions AND NOT goNoDrawView; { View does draw self }
  4737. InitFrame; { Initialize frame }
  4738. If (Frame <> Nil) Then Insert(Frame); { Insert any frame }
  4739. GetBounds(ZoomRect); { Default zoom rect }
  4740. END;
  4741. {--TWindow------------------------------------------------------------------}
  4742. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  4743. {---------------------------------------------------------------------------}
  4744. { This load method will read old original TV data from a stream however }
  4745. { although a frame view is read for compatability it is disposed of. }
  4746. {---------------------------------------------------------------------------}
  4747. CONSTRUCTOR TWindow.Load (Var S: TStream);
  4748. BEGIN
  4749. Inherited Load(S); { Call ancestor }
  4750. S.Read(Flags, 1); { Read window flags }
  4751. S.Read(Number, 2); { Read window number }
  4752. S.Read(Palette, 2); { Read window palette }
  4753. S.Read(ZoomRect.A.X, 2); { Read zoom area x1 }
  4754. S.Read(ZoomRect.A.Y, 2); { Read zoom area y1 }
  4755. S.Read(ZoomRect.B.X, 2); { Read zoom area x2 }
  4756. S.Read(ZoomRect.B.Y, 2); { Read zoom area y2 }
  4757. GetSubViewPtr(S, Frame); { Now read frame object }
  4758. If (Frame <> Nil) Then Begin
  4759. Dispose(Frame, Done); { Kill we don't use it }
  4760. Frame := Nil; { Clear the pointer }
  4761. End;
  4762. Title := S.ReadStr; { Read title }
  4763. END;
  4764. {--TWindow------------------------------------------------------------------}
  4765. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4766. {---------------------------------------------------------------------------}
  4767. DESTRUCTOR TWindow.Done;
  4768. BEGIN
  4769. Inherited Done; { Call ancestor }
  4770. If (Title <> Nil) Then DisposeStr(Title); { Dispose title }
  4771. END;
  4772. {--TWindow------------------------------------------------------------------}
  4773. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4774. {---------------------------------------------------------------------------}
  4775. FUNCTION TWindow.GetPalette: PPalette;
  4776. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  4777. CONST P: ARRAY [wpBlueWindow..wpGrayWindow] Of String =
  4778. (CBlueWindow, CCyanWindow, CGrayWindow); { Possible huge string }
  4779. {$ELSE} { OTHER COMPILERS }
  4780. CONST P: ARRAY [wpBlueWindow..wpGrayWindow] Of String[Length(CBlueWindow)] =
  4781. (CBlueWindow, CCyanWindow, CGrayWindow); { Always normal string }
  4782. {$ENDIF}
  4783. BEGIN
  4784. GetPalette := @P[Palette]; { Return palette }
  4785. END;
  4786. {--TWindow------------------------------------------------------------------}
  4787. { GetTitle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4788. {---------------------------------------------------------------------------}
  4789. FUNCTION TWindow.GetTitle (MaxSize: Integer): TTitleStr;
  4790. VAR S: String;
  4791. BEGIN
  4792. If (Number <> 0) Then begin { Valid window number }
  4793. Str(Number, S); { Window number }
  4794. S := '(' + S + ') '; { Insert in brackets }
  4795. End Else S := ''; { Empty string }
  4796. If (Title <> Nil) Then GetTitle := S + Title^
  4797. Else GetTitle := S; { Return title }
  4798. END;
  4799. {--TWindow------------------------------------------------------------------}
  4800. { StandardScrollBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4801. {---------------------------------------------------------------------------}
  4802. FUNCTION TWindow.StandardScrollBar (AOptions: Word): PScrollBar;
  4803. VAR R: TRect; S: PScrollBar;
  4804. BEGIN
  4805. GetExtent(R); { View extents }
  4806. If (AOptions AND sbVertical = 0) Then
  4807. R.Assign(R.A.X+2, R.B.Y-1, R.B.X-2, R.B.Y) { Horizontal scrollbar }
  4808. Else R.Assign(R.B.X-1, R.A.Y+1, R.B.X, R.B.Y-1); { Vertical scrollbar }
  4809. S := New(PScrollBar, Init(R)); { Create scrollbar }
  4810. Insert(S); { Insert scrollbar }
  4811. If (AOptions AND sbHandleKeyboard <> 0) Then
  4812. S^.Options := S^.Options or ofPostProcess; { Post process }
  4813. StandardScrollBar := S; { Return scrollbar }
  4814. END;
  4815. {--TWindow------------------------------------------------------------------}
  4816. { Zoom -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep97 LdB }
  4817. {---------------------------------------------------------------------------}
  4818. PROCEDURE TWindow.Zoom;
  4819. VAR R: TRect; Max, Min: TPoint;
  4820. BEGIN
  4821. SizeLimits(Min, Max); { Return size limits }
  4822. If ((Size.X <> Max.X) OR (Size.Y <> Max.Y)) { Larger size possible }
  4823. Then Begin
  4824. GetBounds(ZoomRect); { Get zoom bounds }
  4825. R.A.X := 0; { Zero x origin }
  4826. R.A.Y := 0; { Zero y origin }
  4827. R.B := Max; { Bounds to max size }
  4828. Locate(R); { Locate the view }
  4829. End Else Locate(ZoomRect); { Move to zoom rect }
  4830. END;
  4831. {--TWindow------------------------------------------------------------------}
  4832. { Close -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep97 LdB }
  4833. {---------------------------------------------------------------------------}
  4834. PROCEDURE TWindow.Close;
  4835. BEGIN
  4836. If Valid(cmClose) Then Free; { Dispose of self }
  4837. END;
  4838. {--TWindow------------------------------------------------------------------}
  4839. { InitFrame -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4840. {---------------------------------------------------------------------------}
  4841. PROCEDURE TWindow.InitFrame;
  4842. BEGIN { Compatability only }
  4843. END;
  4844. {--TWindow------------------------------------------------------------------}
  4845. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB }
  4846. {---------------------------------------------------------------------------}
  4847. PROCEDURE TWindow.SetState (AState: Word; Enable: Boolean);
  4848. VAR WindowCommands: TCommandSet;
  4849. BEGIN
  4850. Inherited SetState(AState, Enable); { Call ancestor }
  4851. If (AState = sfSelected) Then
  4852. SetState(sfActive, Enable); { Set active state }
  4853. If (AState = sfSelected) OR ((AState = sfExposed)
  4854. AND (State AND sfSelected <> 0)) Then Begin { View is selected }
  4855. WindowCommands := [cmNext, cmPrev]; { Set window commands }
  4856. If (Flags AND (wfGrow + wfMove) <> 0) Then
  4857. WindowCommands := WindowCommands + [cmResize]; { Add resize command }
  4858. If (Flags AND wfClose <> 0) Then
  4859. WindowCommands := WindowCommands + [cmClose]; { Add close command }
  4860. If (Flags AND wfZoom <> 0) Then
  4861. WindowCommands := WindowCommands + [cmZoom]; { Add zoom command }
  4862. If Enable Then EnableCommands(WindowCommands) { Enable commands }
  4863. Else DisableCommands(WindowCommands); { Disable commands }
  4864. End;
  4865. END;
  4866. {--TWindow------------------------------------------------------------------}
  4867. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB }
  4868. {---------------------------------------------------------------------------}
  4869. { You can save data to the stream compatable with the old original TV by }
  4870. { temporarily turning off the ofGrafVersion making the call to this store }
  4871. { routine and resetting the ofGrafVersion flag after the call. }
  4872. {---------------------------------------------------------------------------}
  4873. PROCEDURE TWindow.Store (Var S: TStream);
  4874. BEGIN
  4875. TGroup.Store(S); { Call group store }
  4876. S.Write(Flags, 1); { Write window flags }
  4877. S.Write(Number, 2); { Write window number }
  4878. S.Write(Palette, 2); { Write window palette }
  4879. S.Write(ZoomRect.A.X, 2); { Write zoom area x1 }
  4880. S.Write(ZoomRect.A.Y, 2); { Write zoom area y1 }
  4881. S.Write(ZoomRect.B.X, 2); { Write zoom area x2 }
  4882. S.Write(ZoomRect.B.Y, 2); { Write zoom area y2 }
  4883. PutSubViewPtr(S, Frame); { Write any frame }
  4884. S.WriteStr(Title); { Write title string }
  4885. END;
  4886. {--TWindow------------------------------------------------------------------}
  4887. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11Aug99 LdB }
  4888. {---------------------------------------------------------------------------}
  4889. PROCEDURE TWindow.HandleEvent (Var Event: TEvent);
  4890. VAR {$IFDEF OS_DOS} I, J: Integer; {$ENDIF} Min, Max: TPoint; Limits: TRect;
  4891. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  4892. PROCEDURE DragWindow (Mode: Byte);
  4893. VAR Limits: TRect; Min, Max: TPoint;
  4894. BEGIN
  4895. Owner^.GetExtent(Limits); { Get owner extents }
  4896. SizeLimits(Min, Max); { Restrict size }
  4897. DragView(Event, DragMode OR Mode, Limits, Min,
  4898. Max); { Drag the view }
  4899. ClearEvent(Event); { Clear the event }
  4900. END;
  4901. {$ENDIF}
  4902. BEGIN
  4903. Inherited HandleEvent(Event); { Call ancestor }
  4904. Case Event.What Of
  4905. evNothing: Exit; { Speeds up exit }
  4906. evCommand: { COMMAND EVENT }
  4907. Case Event.Command Of { Command type case }
  4908. cmResize: { RESIZE COMMAND }
  4909. If (Flags AND (wfMove + wfGrow) <> 0) { Window can resize }
  4910. AND (Owner <> Nil) Then Begin { Valid owner }
  4911. Owner^.GetExtent(Limits); { Owners extents }
  4912. SizeLimits(Min, Max); { Check size limits }
  4913. DragView(Event, DragMode OR (Flags AND
  4914. (wfMove + wfGrow)), Limits, Min, Max); { Drag the view }
  4915. ClearEvent(Event); { Clear the event }
  4916. End;
  4917. cmClose: { CLOSE COMMAND }
  4918. If (Flags AND wfClose <> 0) AND { Close flag set }
  4919. ((Event.InfoPtr = Nil) OR { None specific close }
  4920. (Event.InfoPtr = @Self)) Then Begin { Close to us }
  4921. ClearEvent(Event); { Clear the event }
  4922. If (State AND sfModal = 0) Then Close { Non modal so close }
  4923. Else Begin { Modal window }
  4924. Event.What := evCommand; { Command event }
  4925. Event.Command := cmCancel; { Cancel command }
  4926. PutEvent(Event); { Place on queue }
  4927. ClearEvent(Event); { Clear the event }
  4928. End;
  4929. End;
  4930. cmZoom: { ZOOM COMMAND }
  4931. If (Flags AND wfZoom <> 0) AND { Zoom flag set }
  4932. ((Event.InfoPtr = Nil) OR { No specific zoom }
  4933. (Event.InfoPtr = @Self)) Then Begin
  4934. Zoom; { Zoom our window }
  4935. ClearEvent(Event); { Clear the event }
  4936. End;
  4937. End;
  4938. evBroadcast: { BROADCAST EVENT }
  4939. If (Event.Command = cmSelectWindowNum) AND
  4940. (Event.InfoInt = Number) AND { Select our number }
  4941. (Options AND ofSelectable <> 0) Then Begin { Is view selectable }
  4942. Select; { Select our view }
  4943. ClearEvent(Event); { Clear the event }
  4944. End;
  4945. evKeyDown: Begin { KEYDOWN EVENT }
  4946. Case Event.KeyCode Of
  4947. kbTab: Begin { TAB KEY }
  4948. FocusNext(False); { Select next view }
  4949. ClearEvent(Event); { Clear the event }
  4950. End;
  4951. kbShiftTab: Begin { SHIFT TAB KEY }
  4952. FocusNext(True); { Select prior view }
  4953. ClearEvent(Event); { Clear the event }
  4954. End;
  4955. End;
  4956. End;
  4957. {$IFDEF OS_DOS} { DOS/DPMI CODE ONLY }
  4958. evMouseDown: { MOUSE DOWN EVENT }
  4959. If (GOptions AND goTitled <> 0) Then Begin { Must have title area }
  4960. If (GOptions AND goThickFramed <> 0) Then
  4961. I := 5 Else { Thick frame adjust }
  4962. If (Options AND ofFramed <> 0) Then I := 1 { Frame adjust }
  4963. Else I := 0; { No frame size }
  4964. If (Event.Where.Y > (RawOrigin.Y + I)) AND
  4965. (Event.Where.Y < RawOrigin.Y+FontHeight+I)
  4966. Then Begin { Within top line }
  4967. If (Current <> Nil) AND
  4968. (Current^.Options AND ofSelectable <> 0)
  4969. Then Current^.FocusFromTop Else
  4970. FocusFromTop;
  4971. If (Flags AND wfClose <> 0) Then Begin { Has close icon }
  4972. J := I + FontWidth; { Set X value }
  4973. If (Event.Where.X > RawOrigin.X+J) AND
  4974. (Event.Where.X < RawOrigin.X+J+2*FontWidth)
  4975. Then Begin { In close area }
  4976. Event.What := evCommand; { Command event }
  4977. Event.Command := cmClose; { Close command }
  4978. Event.InfoPtr := Nil; { Clear pointer }
  4979. PutEvent(Event); { Put event on queue }
  4980. ClearEvent(Event); { Clear the event }
  4981. Exit; { Now exit }
  4982. End;
  4983. End;
  4984. If (Owner <> Nil) AND (Flags AND wfMove <> 0)
  4985. Then DragWindow(dmDragMove); { Drag the window }
  4986. End Else If (Event.Where.X >= RawOrigin.X + RawSize.X-2*FontWidth) AND
  4987. (Event.Where.Y >= RawOrigin.Y + RawSize.Y - FontHeight)
  4988. Then If (Flags AND wfGrow <> 0) Then { Check grow flags }
  4989. DragWindow(dmDragGrow); { Change window size }
  4990. End;
  4991. {$ENDIF}
  4992. End; { Event.What case end }
  4993. END;
  4994. {--TWindow------------------------------------------------------------------}
  4995. { SizeLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  4996. {---------------------------------------------------------------------------}
  4997. PROCEDURE TWindow.SizeLimits (Var Min, Max: TPoint);
  4998. BEGIN
  4999. Inherited SizeLimits(Min, Max); { View size limits }
  5000. Min.X := MinWinSize.X; { Set min x size }
  5001. Min.Y := MinWinSize.Y; { Set min y size }
  5002. END;
  5003. {$IFNDEF OS_DOS}
  5004. {***************************************************************************}
  5005. { TWindow OBJECT WIN/NT/OS2 ONLY METHODS }
  5006. {***************************************************************************}
  5007. {--TWindow------------------------------------------------------------------}
  5008. { GetClassText -> Platforms WIN/NT/OS2 - Updated 18Jul99 LdB }
  5009. {---------------------------------------------------------------------------}
  5010. FUNCTION TWindow.GetClassText: String;
  5011. BEGIN
  5012. GetClassText := GetTitle(255); { Return window title }
  5013. END;
  5014. {--TWindow------------------------------------------------------------------}
  5015. { GetClassAttr -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  5016. {---------------------------------------------------------------------------}
  5017. FUNCTION TWindow.GetClassAttr: LongInt;
  5018. VAR Li: LongInt;
  5019. BEGIN
  5020. Li := Inherited GetClassAttr; { Call ancestor }
  5021. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5022. If (Flags AND wfZoom <> 0) Then Li := Li OR { Check zoom flags }
  5023. ws_MinimizeBox OR ws_MaximizeBox; { Add min/max boxes }
  5024. If (Flags AND wfClose <> 0) Then { Check close option }
  5025. Li := Li OR ws_SysMenu; { Set menu flag }
  5026. Li := Li OR ws_ClipSiblings OR ws_ClipChildren; { Clip other windows }
  5027. {$ENDIF}
  5028. {$IFDEF OS_OS2} { OS2 CODE }
  5029. If (Flags AND wfZoom <> 0) Then Li := Li OR { Check zoom flags }
  5030. fcf_MinButton OR fcf_MaxButton; { Add min/max boxes }
  5031. If (Flags AND wfClose <> 0) Then { Check close option }
  5032. Li := Li OR fcf_SysMenu; { Set menu flag }
  5033. {$ENDIF}
  5034. GetClassAttr := Li; { Return masks }
  5035. END;
  5036. {$ENDIF}
  5037. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  5038. { UNCOMPLETED OBJECT METHODS }
  5039. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  5040. {--TView--------------------------------------------------------------------}
  5041. { Exposed -> Platforms DOS/DPMI/WIN/OS2 - Checked 17Sep97 LdB }
  5042. {---------------------------------------------------------------------------}
  5043. { This needs big help!!!!! }
  5044. FUNCTION TView.Exposed: Boolean;
  5045. VAR ViewPort: ViewPortType;
  5046. BEGIN
  5047. GetViewSettings(ViewPort); { Fetch viewport }
  5048. If (State AND sfVisible<>0) AND { View visible }
  5049. (State AND sfExposed<>0) AND { View exposed }
  5050. OverlapsArea(ViewPort.X1, ViewPort.Y1,
  5051. ViewPort.X2, ViewPort.Y2) Then Exposed := True { Must be exposed }
  5052. Else Exposed := False; { Is hidden }
  5053. END;
  5054. {--TView--------------------------------------------------------------------}
  5055. { GraphLine -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Sep99 LdB }
  5056. {---------------------------------------------------------------------------}
  5057. PROCEDURE TView.GraphLine (X1, Y1, X2, Y2: Integer; Colour: Byte);
  5058. VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF} { DOS/DPMI VARIABLES }
  5059. {$IFDEF OS_WINDOWS} I: Word; ODc: hDc; {$ENDIF} { WIN/NT VARIABLES }
  5060. {$IFDEF OS_OS2} I: LongInt; Lp: PointL; OPs: HPs; {$ENDIF}{ OS2 VARIABLES }
  5061. BEGIN
  5062. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5063. GetViewSettings(ViewPort); { Get viewport settings }
  5064. SetColor(Colour); { Set line colour }
  5065. Line(RawOrigin.X + X1 - ViewPort.X1,
  5066. RawOrigin.Y + Y1 - ViewPort.Y1, RawOrigin.X + X2
  5067. - ViewPort.X1, RawOrigin.Y + Y2-ViewPort.Y1); { Draw the line }
  5068. {$ENDIF}
  5069. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5070. If (HWindow <> 0) Then Begin { Valid window }
  5071. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5072. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5073. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5074. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5075. ODc := Dc; { Hold device context }
  5076. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5077. SelectObject(Dc, ColPen[Colour]); { Select line colour }
  5078. Case WriteMode Of
  5079. NormalPut: I := R2_CopyPen; { Normal overwrite }
  5080. AndPut: I := R2_MaskPen; { AND colour write }
  5081. OrPut: I := R2_MergePen; { OR colour write }
  5082. XorPut: I := R2_XORPen; { XOR colour write }
  5083. NotPut: I := R2_Not; { NOT colour write }
  5084. End;
  5085. SetRop2(Dc, I); { Set write mode }
  5086. {$IFDEF BIT_16} { 16 BIT WIN CODE }
  5087. WinProcs.MoveTo(Dc, X1, Y1); { Move to first point }
  5088. {$ELSE} { 32 BIT WIN/NT CODE }
  5089. MoveToEx(Dc, X1, Y1, Nil); { Move to first point }
  5090. {$ENDIF}
  5091. If (Abs(X2-X1) > 1) OR (Abs(Y2-Y1) > 1) Then { Not single point }
  5092. LineTo(Dc, X2, Y2); { Line to second point }
  5093. SetPixel(Dc, X2, Y2, ColRef[Colour]); { Draw last point }
  5094. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5095. Dc := ODc; { Reset held context }
  5096. End;
  5097. {$ENDIF}
  5098. {$IFDEF OS_OS2} { OS2 CODE }
  5099. If (HWindow <> 0) Then Begin { Valid window }
  5100. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5101. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5102. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5103. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5104. OPs := Ps; { Hold paint struct }
  5105. If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
  5106. Case WriteMode Of
  5107. NormalPut: I := fm_Overpaint; { Normal overwrite }
  5108. AndPut: I := fm_And; { AND colour write }
  5109. OrPut: I := fm_Or; { OR colour write }
  5110. XorPut: I := fm_Xor; { XOR colour write }
  5111. NotPut: I := fm_Invert; { NOT colour write }
  5112. End;
  5113. GPISetMix(Ps, I); { Set write mode }
  5114. GPISetColor(Ps, ColRef[Colour]);
  5115. Lp.X := X1; { Transfer x1 value }
  5116. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5117. GPIMove(Ps, Lp); { Move to first point }
  5118. Lp.X := X2; { Transfer x2 value }
  5119. Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
  5120. GPILine(Ps, Lp); { Line to second point }
  5121. If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
  5122. Ps := OPs; { Reset held struct }
  5123. End;
  5124. {$ENDIF}
  5125. END;
  5126. PROCEDURE TView.GraphRectangle (X1, Y1, X2, Y2: Integer; Colour: Byte);
  5127. VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
  5128. {$IFDEF OS_WINDOWS} I: Word; ODc: hDc; {$ENDIF}
  5129. {$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
  5130. BEGIN
  5131. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5132. SetColor(Colour); { Set line colour }
  5133. GetViewSettings(ViewPort);
  5134. Rectangle(RawOrigin.X + X1 - ViewPort.X1, RawOrigin.Y + Y1
  5135. - ViewPort.Y1, RawOrigin.X + X2 - ViewPort.X1,
  5136. RawOrigin.Y+Y2-ViewPort.Y1); { Draw a rectangle }
  5137. {$ENDIF}
  5138. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5139. If (HWindow <> 0) Then Begin { Valid window }
  5140. X1 := X1 - FrameSize;
  5141. X2 := X2 - FrameSize;
  5142. Y1 := Y1 - CaptSize;
  5143. Y2 := Y2 - CaptSize;
  5144. ODc := Dc; { Hold device context }
  5145. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5146. SelectObject(Dc, ColPen[Colour]);
  5147. Case WriteMode Of
  5148. NormalPut: I := R2_CopyPen; { Normal overwrite }
  5149. AndPut: I := R2_MaskPen; { AND colour write }
  5150. OrPut: I := R2_MergePen; { OR colour write }
  5151. XorPut: I := R2_XORPen; { XOR colour write }
  5152. NotPut: I := R2_Not; { NOT colour write }
  5153. End;
  5154. SetRop2(Dc, I);
  5155. {$IFDEF WIN32}
  5156. MoveToEx(Dc, X1, Y1, Nil); { Move to first point }
  5157. {$ELSE}
  5158. WinProcs.MoveTo(Dc, X1, Y1); { Move to first point }
  5159. {$ENDIF}
  5160. LineTo(Dc, X2, Y1); { Line to second point }
  5161. LineTo(Dc, X2, Y2); { Line to third point }
  5162. LineTo(Dc, X1, Y2); { Line to fourth point }
  5163. LineTo(Dc, X1, Y1); { Line to first point }
  5164. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5165. Dc := ODc; { Reset held context }
  5166. End;
  5167. {$ENDIF}
  5168. {$IFDEF OS_OS2} { OS2 CODE }
  5169. If (HWindow <> 0) Then Begin { Valid window }
  5170. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5171. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5172. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5173. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5174. OPs := Ps; { Hold paint struct }
  5175. If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
  5176. GPISetColor(Ps, ColRef[Colour]); { Set colour }
  5177. Lp.X := X1; { Transfer x1 value }
  5178. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5179. GPIMove(Ps, Lp); { Move to first point }
  5180. Lp.X := X2; { Transfer x2 value }
  5181. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5182. GPILine(Ps, Lp); { Line to second point }
  5183. Lp.X := X2; { Transfer x2 value }
  5184. Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
  5185. GPILine(Ps, Lp); { Line to third point }
  5186. Lp.X := X1; { Transfer x1 value }
  5187. Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
  5188. GPILine(Ps, Lp); { Line to fourth point }
  5189. Lp.X := X1; { Transfer x1 value }
  5190. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5191. GPILine(Ps, Lp); { Line to first point }
  5192. If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
  5193. Ps := OPs; { Reset held struct }
  5194. End;
  5195. {$ENDIF}
  5196. END;
  5197. {--TView--------------------------------------------------------------------}
  5198. { ClearArea -> Platforms DOS/DPMI/WIN/OS2 - Checked 19Sep97 LdB }
  5199. {---------------------------------------------------------------------------}
  5200. PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
  5201. VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
  5202. {$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
  5203. {$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
  5204. BEGIN
  5205. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5206. GetViewSettings(ViewPort); { Get viewport }
  5207. SetFillStyle(SolidFill, Colour); { Set colour up }
  5208. Bar(RawOrigin.X+X1-ViewPort.X1, RawOrigin.Y+Y1-
  5209. ViewPort.Y1, RawOrigin.X+X2-ViewPort.X1,
  5210. RawOrigin.Y+Y2-ViewPort.Y1); { Clear the area }
  5211. {$ENDIF}
  5212. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5213. If (HWindow <> 0) Then Begin { Valid window }
  5214. X1 := X1 - FrameSize; { Correct for frame }
  5215. Y1 := Y1 - CaptSize; { Correct for caption }
  5216. X2 := X2 - FrameSize; { Correct for frame }
  5217. Y2 := Y2 - CaptSize; { Correct for caption }
  5218. ODc := Dc; { Hold device context }
  5219. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5220. SelectObject(Dc, ColPen[Colour]);
  5221. SelectObject(Dc, ColBrush[Colour]);
  5222. {$IFNDEF PPC_SPEED}
  5223. Rectangle(Dc, X1, Y1, X2+1, Y2+1);
  5224. {$ELSE} { SPEEDSOFT SYBIL2+ }
  5225. WinGDI.Rectangle(Dc, X1, Y1, X2+1, Y2+1);
  5226. {$ENDIF}
  5227. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5228. Dc := ODc; { Reset held context }
  5229. End;
  5230. {$ENDIF}
  5231. {$IFDEF OS_OS2} { OS2 CODE }
  5232. If (HWindow <> 0) Then Begin { Valid window }
  5233. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5234. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5235. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5236. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5237. OPs := Ps; { Hold paint struct }
  5238. If (Ps = 0) Then Ps := WinGetPs(Client); { Create paint struct }
  5239. GpiSetColor(Ps, ColRef[Colour]);
  5240. Lp.X := X1;
  5241. Lp.Y := RawSize.Y-Y1;
  5242. GpiMove(Ps, Lp);
  5243. Lp.X := X2;
  5244. Lp.Y := RawSize.Y-Y2;
  5245. GpiBox(Ps, dro_Fill, Lp, 0, 0);
  5246. If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
  5247. Ps := OPs; { Reset held struct }
  5248. End;
  5249. {$ENDIF}
  5250. END;
  5251. PROCEDURE TView.GraphArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad: Integer;
  5252. Colour: Byte);
  5253. CONST RadConv = 57.2957795130823229; { Degrees per radian }
  5254. VAR X1, Y1, X2, Y2: Integer; {$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
  5255. BEGIN
  5256. {$IFDEF OS_WINDOWS}
  5257. Xc := Xc - FrameSize;
  5258. Yc := Yc - CaptSize;
  5259. {$ENDIF}
  5260. While (Ea < -360) Do Ea := Ea + 360; { Max of a full circle }
  5261. While (Ea > 360) Do Ea := Ea - 360; { Max of a full circle }
  5262. Sa := Sa/RadConv; { Convert to radians }
  5263. Ea := Ea/RadConv; { Convert to radians }
  5264. X1 := Xc + Round(Sin(Sa)*XRad); { Calc 1st x value }
  5265. Y1 := Yc - Round(Cos(Sa)*YRad); { Calc 1st y value }
  5266. X2 := Xc + Round(Sin(Sa+Ea)*XRad); { Calc 2nd x value }
  5267. Y2 := Yc - Round(Cos(Sa+Ea)*YRad); { Calc 2nd y value }
  5268. {$IFDEF OS_WINDOWS}
  5269. If (HWindow <> 0) Then Begin { Valid window }
  5270. ODc := Dc; { Hold device context }
  5271. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5272. SelectObject(Dc, ColPen[Colour]); { Pen colour }
  5273. If (XRad > 2 ) AND (YRAd > 2) Then Begin { Must exceed 2x2 arc }
  5274. If (Ea < 0) Then
  5275. Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
  5276. X1, Y1, X2, Y2) Else { Draw c/clkwise arc }
  5277. Arc(Dc, Xc-XRad, Yc+YRad, Xc+XRad, Yc-YRad,
  5278. X2, Y2, X1, Y1); { Draw clockwise arc }
  5279. End;
  5280. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5281. Dc := ODc; { Reset held context }
  5282. End;
  5283. {$ENDIF}
  5284. END;
  5285. PROCEDURE TView.FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
  5286. Colour: Byte);
  5287. CONST RadConv = 57.2957795130823229; { Degrees per radian }
  5288. {$IFDEF OS_WINDOWS} VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; ODc: hDc; {$ENDIF}
  5289. BEGIN
  5290. {$IFDEF OS_WINDOWS}
  5291. If (HWindow <> 0) Then Begin { Valid window }
  5292. Xc := Xc - FrameSize;
  5293. Yc := Yc - CaptSize;
  5294. ODc := Dc; { Hold device context }
  5295. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5296. Ea := (Ea-Sa);
  5297. While (Ea<-360) Do Ea := Ea+360; { One lap only }
  5298. While (Ea>360) Do Ea := Ea-360; { One lap only }
  5299. X1 := Round(Sin(Sa/RadConv)*XRad);
  5300. Y1 := -Round(Cos(Sa/RadConv)*YRad); { Calc 1st values }
  5301. X2 := Round(Sin((Sa+Ea)/RadConv)*XRad);
  5302. Y2 := -Round(Cos((Sa+Ea)/RadConv)*YRad); { Calc 2nd values }
  5303. X3 := Round(Sin(Sa/RadConv)*(XRad+Ht));
  5304. Y3 := -Round(Cos(Sa/RadConv)*(YRad+Ht)); { Calc 3rd values }
  5305. X4 := Round(Sin((Sa+Ea)/RadConv)*(XRad+Ht));
  5306. Y4 := -Round(Cos((Sa+Ea)/RadConv)*(YRad+Ht)); { Calc 4th values }
  5307. SelectObject(Dc, ColPen[Colour]); { Pen colour }
  5308. {$IFDEF WIN32}
  5309. MoveToEx(Dc, Xc+X1, Yc+Y1, Nil); { Move to first point }
  5310. {$ELSE}
  5311. WinProcs.MoveTo(Dc, Xc+X1, Yc+Y1); { Move to first point }
  5312. {$ENDIF}
  5313. LineTo(Dc, Xc+X3, Yc+Y3);
  5314. {$IFDEF WIN32}
  5315. MoveToEx(Dc, Xc+X2, Yc+Y2, Nil);
  5316. {$ELSE}
  5317. WinProcs.MoveTo(Dc, Xc+X2, Yc+Y2);
  5318. {$ENDIF}
  5319. LineTo(Dc, Xc+X4, Yc+Y4);
  5320. If (Ea < 0) Then
  5321. Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht,
  5322. Xc+X1, Yc+Y1, Xc+X2, Yc+Y2) Else
  5323. Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht,
  5324. Xc+X2, Yc+Y2, Xc+X1, Yc+Y1); { Draw arc }
  5325. If (Ea < 0) Then
  5326. Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
  5327. Xc+X3, Yc+Y3, Xc+X4, Yc+Y4) Else
  5328. Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
  5329. Xc+X4, Yc+Y4, Xc+X3, Yc+Y3); { Draw arc }
  5330. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5331. Dc := ODc; { Reset held context }
  5332. End;
  5333. {$ENDIF}
  5334. END;
  5335. {--TView--------------------------------------------------------------------}
  5336. { BiColorRectangle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  5337. {---------------------------------------------------------------------------}
  5338. PROCEDURE TView.BicolorRectangle (X1, Y1, X2, Y2: Integer; Light, Dark: Byte;
  5339. Down: Boolean);
  5340. VAR UpperLeft, RightDown: Byte;
  5341. BEGIN
  5342. If Down Then Begin
  5343. UpperLeft := Dark; { Dark upper left }
  5344. RightDown := Light; { Light down }
  5345. End Else Begin
  5346. UpperLeft := Light; { Light upper left }
  5347. RightDown := Dark; { Dark down }
  5348. End;
  5349. GraphLine(X1, Y1, X1, Y2, UpperLeft); { Draw left side }
  5350. GraphLine(X1, Y1, X2, Y1, UpperLeft); { Draw top line }
  5351. GraphLine(X1, Y2, X2, Y2, RightDown); { Draw bottom line }
  5352. GraphLine(X2, Y1, X2, Y2, RightDown); { Draw right line }
  5353. END;
  5354. PROCEDURE TView.WriteBuf (X, Y, W, H: Integer; Var Buf);
  5355. VAR I, J, K, L, CW: Integer; P: PDrawBuffer;
  5356. {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
  5357. {$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF}
  5358. {$IFDEF OS_OS2} OPs: HPs; Pt: PointL; {$ENDIF}
  5359. BEGIN
  5360. If (State AND sfVisible <> 0) AND { View is visible }
  5361. (State AND sfIconised = 0) AND { View is not icon}
  5362. (State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
  5363. {$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
  5364. Then Begin
  5365. P := @TDrawBuffer(Buf); { Set draw buffer ptr }
  5366. L := 0; { Set buffer position }
  5367. If (GOptions AND (goGraphical + goGraphView)= 0) Then Begin { Not raw graphical }
  5368. X := X * SysFontWidth; { X graphical adjust }
  5369. Y := Y * SysFontHeight; { Y graphical adjust }
  5370. End;
  5371. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5372. GetViewSettings(ViewPort); { Get current viewport }
  5373. X := X + RawOrigin.X - ViewPort.X; { Calc x position }
  5374. Y := Y + RawOrigin.Y - ViewPort.Y; { Calc y position }
  5375. {$ENDIF}
  5376. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5377. ODc := Dc; { Hold device context }
  5378. If (Dc = 0) Then Dc := GetDC(HWindow); { If needed get context }
  5379. SelectObject(Dc, DefGFVFont); { Select the font }
  5380. {$ENDIF}
  5381. {$IFDEF OS_OS2} { OS2 CODE }
  5382. OPs := Ps; { Hold pres space }
  5383. If (Ps = 0) Then Ps := WinGetPS(Client); { If needed get PS }
  5384. GPISetCharSet(Ps, DefGFVFont); { Select the font }
  5385. GpiSetBackMix(Ps, bm_OverPaint); { Set overpaint mode }
  5386. {$ENDIF}
  5387. For J := 1 To H Do Begin { For each line }
  5388. K := X; { Reset x position }
  5389. For I := 0 To (W-1) Do Begin { For each character }
  5390. Cw := TextWidth(Chr(Lo(P^[L]))); { Width of this char }
  5391. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5392. SetFillStyle(SolidFill, Hi(P^[L]) AND $F0
  5393. SHR 4); { Set back colour }
  5394. SetColor(Hi(P^[L]) AND $0F); { Set text colour }
  5395. Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
  5396. OutTextXY(K, Y+2, Chr(Lo(P^[L]))); { Write text char }
  5397. {$ENDIF}
  5398. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5399. SetBkColor(Dc, ColRef[Hi(P^[L]) AND $F0
  5400. SHR 4]); { Set back colour }
  5401. SetTextColor(Dc, ColRef[Hi(P^[L])
  5402. AND $0F]); { Set text colour }
  5403. TextOut(Dc, K, Y, @P^[L], 1); { Write text char }
  5404. {$ENDIF}
  5405. {$IFDEF OS_OS2} { OS2 CODE }
  5406. GPISetBackColor(Ps, ColRef[Hi(P^[L])
  5407. AND $F0 SHR 4]); { Set back colour }
  5408. GpiSetColor(Ps, ColRef[Hi(P^[L])
  5409. AND $0F]); { Set text colour }
  5410. Pt.X := K;
  5411. Pt.Y := RawSize.Y - Y - FontHeight + 5;
  5412. GpiCharStringAt(Ps, Pt, 1, @P^[L]); { Write text char }
  5413. {$ENDIF}
  5414. K := K + Cw; { Add char width }
  5415. Inc(L); { Next character }
  5416. End;
  5417. Y := Y + SysFontHeight; { Next line down }
  5418. End;
  5419. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5420. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5421. Dc := ODc; { Restore old context }
  5422. {$ENDIF}
  5423. {$IFDEF OS_OS2} { OS2 CODE }
  5424. If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
  5425. Ps := OPs; { Restore original PS }
  5426. {$ENDIF}
  5427. End;
  5428. END;
  5429. PROCEDURE TView.WriteLine (X, Y, W, H: Integer; Var Buf);
  5430. VAR I, J, K, Cw: Integer; P: PDrawBuffer;
  5431. {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
  5432. {$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF}
  5433. {$IFDEF OS_OS2} OPs: HPs; Pt: PointL; {$ENDIF}
  5434. BEGIN
  5435. If (State AND sfVisible <> 0) AND { View is visible }
  5436. (State AND sfIconised = 0) AND { View is not icon}
  5437. (State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
  5438. {$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
  5439. Then Begin
  5440. P := @TDrawBuffer(Buf); { Set draw buffer ptr }
  5441. If (GOptions AND (goGraphical + goGraphView)= 0) Then Begin { Not raw graphical }
  5442. X := X * SysFontWidth; { X graphical adjust }
  5443. Y := Y * SysFontHeight; { Y graphical adjust }
  5444. End;
  5445. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5446. GetViewSettings(ViewPort); { Get current viewport }
  5447. X := X + RawOrigin.X - ViewPort.X; { Calc x position }
  5448. Y := Y + RawOrigin.Y - ViewPort.Y; { Calc y position }
  5449. {$ENDIF}
  5450. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5451. ODc := Dc; { Hold device context }
  5452. If (Dc = 0) Then Dc := GetDC(HWindow); { If needed get context }
  5453. SelectObject(Dc, DefGFVFont); { Select the font }
  5454. {$ENDIF}
  5455. {$IFDEF OS_OS2} { OS2 CODE }
  5456. OPs := Ps; { Hold pres space }
  5457. If (Ps = 0) Then Ps := WinGetPS(Client); { If needed get PS }
  5458. GPISetCharSet(Ps, DefGFVFont); { Select the font }
  5459. GpiSetBackMix(Ps, bm_OverPaint); { Set overpaint mode }
  5460. {$ENDIF}
  5461. For J := 1 To H Do Begin { For each line }
  5462. K := X; { Reset x position }
  5463. For I := 0 To (W-1) Do Begin { For each character }
  5464. Cw := TextWidth(Chr(Lo(P^[I]))); { Width of this char }
  5465. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5466. SetFillStyle(SolidFill, Hi(P^[I]) AND $F0
  5467. SHR 4); { Set back colour }
  5468. SetColor(Hi(P^[I]) AND $0F); { Set text colour }
  5469. Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
  5470. OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char }
  5471. {$ENDIF}
  5472. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5473. SetBkColor(Dc, ColRef[Hi(P^[I]) AND $F0
  5474. SHR 4]); { Set back colour }
  5475. SetTextColor(Dc, ColRef[Hi(P^[I])
  5476. AND $0F]); { Set text colour }
  5477. TextOut(Dc, K, Y, @P^[I], 1); { Write text char }
  5478. {$ENDIF}
  5479. {$IFDEF OS_OS2} { OS2 CODE }
  5480. GPISetBackColor(Ps, ColRef[Hi(P^[I])
  5481. AND $F0 SHR 4]); { Set back colour }
  5482. GpiSetColor(Ps, ColRef[Hi(P^[I])
  5483. AND $0F]); { Set text colour }
  5484. Pt.X := K;
  5485. Pt.Y := RawSize.Y - Y - FontHeight + 5;
  5486. GpiCharStringAt(Ps, Pt, 1, @P^[I]); { Write text char }
  5487. {$ENDIF}
  5488. K := K + Cw; { Add char width }
  5489. End;
  5490. Y := Y + SysFontHeight; { Next line down }
  5491. End;
  5492. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5493. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5494. Dc := ODc; { Restore old context }
  5495. {$ENDIF}
  5496. {$IFDEF OS_OS2} { OS2 CODE }
  5497. If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
  5498. Ps := OPs; { Restore original PS }
  5499. {$ENDIF}
  5500. End;
  5501. END;
  5502. {--TView--------------------------------------------------------------------}
  5503. { MakeLocal -> Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB }
  5504. {---------------------------------------------------------------------------}
  5505. PROCEDURE TView.MakeLocal (Source: TPoint; Var Dest: TPoint);
  5506. BEGIN
  5507. If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW }
  5508. Dest.X := (Source.X-RawOrigin.X) DIV FontWidth; { Local x value }
  5509. Dest.Y := (Source.Y-RawOrigin.Y) DIV FontHeight; { Local y value }
  5510. End Else Begin { OLD MODE TVIEW }
  5511. Dest.X := Source.X - Origin.X; { Local x value }
  5512. Dest.Y := Source.Y - Origin.Y; { Local y value }
  5513. End;
  5514. END;
  5515. {--TView--------------------------------------------------------------------}
  5516. { MakeGlobal -> Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB }
  5517. {---------------------------------------------------------------------------}
  5518. PROCEDURE TView.MakeGlobal (Source: TPoint; Var Dest: TPoint);
  5519. BEGIN
  5520. If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW }
  5521. Dest.X := Source.X*FontWidth + RawOrigin.X; { Global x value }
  5522. Dest.Y := Source.Y*FontHeight + RawOrigin.Y; { Global y value }
  5523. End Else Begin { OLD MODE TVIEW }
  5524. Dest.X := Source.X + Origin.X; { Global x value }
  5525. Dest.Y := Source.Y + Origin.Y; { Global y value }
  5526. End;
  5527. END;
  5528. PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
  5529. VAR Fc, Bc: Byte; X1, Y1, X2, Y2: Integer;
  5530. {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
  5531. {$IFDEF OS_WINDOWS} ODc: HDc; P: Pointer; {$ENDIF}
  5532. {$IFDEF OS_OS2} OPs: HPs; P: Pointer; Pt: PointL; {$ENDIF}
  5533. BEGIN
  5534. If (State AND sfVisible <> 0) AND { View is visible }
  5535. (State AND sfExposed <> 0) AND { View is exposed }
  5536. (State AND sfIconised = 0) AND { View not iconized }
  5537. (Length(Str) > 0) Then Begin { String is valid }
  5538. Fc := GetColor(Color); { Get view color }
  5539. Bc := Fc AND $F0 SHR 4; { Calc back colour }
  5540. Fc := Fc AND $0F; { Calc text colour }
  5541. {$IFDEF OS_DOS}
  5542. If (X >= 0) AND (Y >= 0) Then Begin
  5543. X := RawOrigin.X+X*FontWidth; { X position }
  5544. Y := RawOrigin.Y+Y*FontHeight; { Y position }
  5545. End Else Begin
  5546. X := RawOrigin.X + Abs(X);
  5547. Y := RawOrigin.Y + Abs(Y);
  5548. End;
  5549. GetViewSettings(ViewPort);
  5550. SetFillStyle(SolidFill, Bc); { Set fill style }
  5551. Bar(X-ViewPort.X1, Y-ViewPort.Y1,
  5552. X-ViewPort.X1+Length(Str)*FontWidth, Y-ViewPort.Y1+FontHeight-1);
  5553. SetColor(Fc);
  5554. OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1+2, Str); { Write text char }
  5555. {$ENDIF}
  5556. {$IFDEF OS_WINDOWS}
  5557. If (HWindow <> 0) Then Begin
  5558. ODc := Dc; { Hold device handle }
  5559. If (Dc = 0) Then Dc := GetDC(HWindow); { Chk capture context }
  5560. SelectObject(Dc, DefGFVFont);
  5561. SetTextColor(Dc, ColRef[Fc]); { Set text colour }
  5562. SetBkColor(Dc, ColRef[Bc]); { Set back colour }
  5563. If (GOptions AND goGraphView <> 0) OR (X < 0)
  5564. OR (Y < 0) Then Begin
  5565. X := Abs(X);
  5566. Y := Abs(Y);
  5567. X1 := X - FrameSize; { Left position }
  5568. Y1 := Y - CaptSize; { Top position }
  5569. X2 := X1 + TextWidth(Str); { Right position }
  5570. End Else Begin
  5571. X1 := X * FontWidth - FrameSize; { Left position }
  5572. Y1 := Y * FontHeight - CaptSize; { Top position }
  5573. X2 := X1 + Length(Str)*FontWidth; { Right position }
  5574. End;
  5575. Y2 := Y1 + FontHeight; { Bottom position }
  5576. SelectObject(Dc, ColPen[Bc]); { Select pen }
  5577. SelectObject(Dc, ColBrush[Bc]); { Select brush }
  5578. P := @Str[1];
  5579. Rectangle(Dc, X1, Y1, X2, Y2); { Clear the area }
  5580. {$IFNDEF PPC_SPEED}
  5581. TextOut(Dc, X1, Y1, P, Length(Str)); { Write text data }
  5582. {$ELSE} { SPEEDSOFT SYBIL2+ }
  5583. TextOut(Dc, X1, Y1, CString(P), Length(Str)); { Write text data }
  5584. {$ENDIF}
  5585. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5586. Dc := ODc; { Clear device handle }
  5587. End;
  5588. {$ENDIF}
  5589. {$IFDEF OS_OS2}
  5590. If (HWindow <> 0) Then Begin
  5591. OPs := Ps; { Hold device handle }
  5592. If (Ps = 0) Then Ps := WinGetPs(Client); { Chk capture context }
  5593. {SelectObject(Dc, DefGFVFont);}
  5594. If (GOptions AND goGraphView <> 0) OR (X < 0)
  5595. OR (Y < 0) Then Begin
  5596. X := Abs(X);
  5597. Y := Abs(Y);
  5598. X1 := X - FrameSize; { Left position }
  5599. Y1 := Y - CaptSize; { Top position }
  5600. X2 := X1 + TextWidth(Str); { Right position }
  5601. End Else Begin
  5602. X1 := X * FontWidth - FrameSize; { Left position }
  5603. Y1 := Y * FontHeight - CaptSize; { Top position }
  5604. X2 := X1 + Length(Str)*FontWidth; { Right position }
  5605. End;
  5606. Y2 := Y1 + FontHeight; { Bottom position }
  5607. {SelectObject(Dc, ColPen[Bc]);} { Select pen }
  5608. {SelectObject(Dc, ColBrush[Bc]);} { Select brush }
  5609. P := @Str[1];
  5610. (*Pt.X := X1;
  5611. Pt.Y := RawSize.Y - Y1;
  5612. GpiMove(Ps, Pt);
  5613. Pt.X := X2;
  5614. Pt.Y := RawSize.Y - Y2;
  5615. GpiSetColor(Ps, ColRef[Bc]); { Set text colour }
  5616. GpiBox(Ps, dro_Fill, Pt, 0, 0);*)
  5617. GpiSetColor(Ps, ColRef[Fc]); { Set text colour }
  5618. GpiSetBackColor(Ps, ColRef[Bc]); { Set back colour }
  5619. GpiSetBackMix(Ps, bm_OverPaint );
  5620. Pt.X := X1;
  5621. Pt.Y := RawSize.Y - Y1 - FontHeight + 5;
  5622. GpiCharStringAt(Ps, Pt, Length(Str), P); { Write text char }
  5623. If (OPs = 0) Then WinReleasePs(Ps); { Release context }
  5624. Ps := OPs; { Clear device handle }
  5625. End;
  5626. {$ENDIF}
  5627. End;
  5628. END;
  5629. PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
  5630. Count: Integer);
  5631. VAR Fc, Bc: Byte; I: Integer; Col: Word; S: String; ViewPort: ViewPortType;
  5632. BEGIN
  5633. {$IFDEF OS_DOS}
  5634. If (State AND sfVisible <> 0) AND { View visible }
  5635. (State AND sfExposed <> 0) Then Begin { View exposed }
  5636. GetViewSettings(ViewPort);
  5637. Col := GetColor(Color); { Get view color }
  5638. Fc := Col AND $0F; { Foreground colour }
  5639. Bc := Col AND $F0 SHR 4; { Background colour }
  5640. X := RawOrigin.X + X*FontWidth; { X position }
  5641. Y := RawOrigin.Y + Y*FontHeight; { Y position }
  5642. FillChar(S[1], 255, C); { Fill the string }
  5643. While (Count>0) Do Begin
  5644. If (Count>255) Then I := 255 Else I := Count; { Size to make }
  5645. S[0] := Chr(I); { Set string length }
  5646. SetFillStyle(SolidFill, Bc); { Set fill style }
  5647. Bar(X-ViewPort.X1, Y-ViewPort.Y1,
  5648. X-ViewPort.X1+Length(S)*FontWidth, Y-ViewPort.Y1+FontHeight-1);
  5649. SetColor(Fc);
  5650. OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1, S); { Write text char }
  5651. Count := Count - I; { Subtract count }
  5652. X := X + I*FontWidth; { Move x position }
  5653. End;
  5654. End;
  5655. {$ENDIF}
  5656. END;
  5657. PROCEDURE TView.DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
  5658. MinSize, MaxSize: TPoint);
  5659. VAR PState: Word; Mouse, Q, R, P, S, Op1, Op2: TPoint; SaveBounds: TRect;
  5660. FUNCTION Min (I, J: Integer): Integer;
  5661. BEGIN
  5662. If (I < J) Then Min := I Else Min := J; { Select minimum }
  5663. END;
  5664. FUNCTION Max (I, J: Integer): Integer;
  5665. BEGIN
  5666. If (I > J) Then Max := I Else Max := J; { Select maximum }
  5667. END;
  5668. PROCEDURE MoveGrow (P, S: TPoint);
  5669. VAR R: TRect;
  5670. BEGIN
  5671. S.X := Min(Max(S.X, MinSize.X), MaxSize.X); { Minimum S.X value }
  5672. S.Y := Min(Max(S.Y, MinSize.Y), MaxSize.Y); { Minimum S.Y value }
  5673. P.X := Min(Max(P.X, Limits.A.X - S.X + 1),
  5674. Limits.B.X - 1); { Minimum P.X value }
  5675. P.Y := Min(Max(P.Y, Limits.A.Y - S.Y + 1),
  5676. Limits.B.Y - 1); { Mimimum P.Y value }
  5677. If (Mode AND dmLimitLoX <> 0) Then
  5678. P.X := Max(P.X, Limits.A.X); { Left side move }
  5679. If (Mode AND dmLimitLoY <> 0) Then
  5680. P.Y := Max(P.Y, Limits.A.Y); { Top side move }
  5681. If (Mode AND dmLimitHiX <> 0) Then
  5682. P.X := Min(P.X, Limits.B.X - S.X); { Right side move }
  5683. If (Mode AND dmLimitHiY <> 0) Then
  5684. P.Y := Min(P.Y, Limits.B.Y - S.Y); { Bottom side move }
  5685. R.Assign(P.X, P.Y, P.X + S.X, P.Y + S.Y); { Assign area }
  5686. Locate(R); { Locate view }
  5687. END;
  5688. PROCEDURE Change (DX, DY: Integer);
  5689. BEGIN
  5690. If (Mode AND dmDragMove <> 0) AND
  5691. (GetShiftState AND $03 = 0) Then Begin
  5692. Inc(P.X, DX); Inc(P.Y, DY); { Adjust values }
  5693. End Else If (Mode AND dmDragGrow <> 0) AND
  5694. (GetShiftState AND $03 <> 0) Then Begin
  5695. Inc(S.X, DX); Inc(S.Y, DY); { Adjust values }
  5696. End;
  5697. END;
  5698. PROCEDURE Update (X, Y: Integer);
  5699. BEGIN
  5700. If (Mode AND dmDragMove <> 0) Then Begin
  5701. P.X := X; P.Y := Y; { Adjust values }
  5702. End;
  5703. END;
  5704. BEGIN
  5705. SetState(sfDragging, True); { Set drag state }
  5706. If (Event.What = evMouseDown) Then Begin { Mouse down event }
  5707. Q.X := Event.Where.X DIV FontWidth - Origin.X; { Offset mouse x origin }
  5708. Q.Y := Event.Where.Y DIV FontHeight - Origin.Y; { Offset mouse y origin }
  5709. Op1.X := RawOrigin.X; Op1.Y := RawOrigin.Y; { Hold origin point }
  5710. Op2.X := RawOrigin.X+RawSize.X; { Right side x value }
  5711. Op2.Y := RawOrigin.Y+RawSize.Y; { Right side y value }
  5712. PState := State; { Hold current state }
  5713. State := State AND NOT sfVisible; { Temp not visible }
  5714. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5715. HideMouseCursor; { Hide the mouse }
  5716. {$ENDIF}
  5717. SetWriteMode(XORPut);
  5718. GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
  5719. SetWriteMode(NormalPut);
  5720. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5721. ShowMouseCursor; { Show the mouse }
  5722. {$ENDIF}
  5723. Repeat
  5724. Mouse.X := Round(Event.Where.X/FontWidth)-Q.X; { New x origin point }
  5725. Mouse.Y := Round(Event.Where.Y/FontHeight)-Q.Y;{ New y origin point }
  5726. If (Mode AND dmDragMove<>0) Then Begin
  5727. If (Owner<>Nil) Then Begin
  5728. Dec(Mouse.X, Owner^.Origin.X); { Sub owner x origin }
  5729. Dec(Mouse.Y, Owner^.Origin.Y); { Sub owner y origin }
  5730. End;
  5731. R := Mouse; Mouse := Size; { Exchange values }
  5732. End Else Begin
  5733. R := Origin; { Start at origin }
  5734. If (Owner<>Nil) Then Begin
  5735. Dec(R.X, Owner^.Origin.X); { Sub owner x origin }
  5736. Dec(R.Y, Owner^.Origin.Y); { Sub owner y origin }
  5737. End;
  5738. Mouse.X := Mouse.X+Q.X-Origin.X;
  5739. Mouse.Y := Mouse.Y+Q.Y-Origin.Y;
  5740. End;
  5741. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5742. HideMouseCursor; { Hide the mouse }
  5743. {$ENDIF}
  5744. SetWriteMode(XORPut);
  5745. GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
  5746. SetWriteMode(NormalPut);
  5747. MoveGrow(R, Mouse); { Resize the view }
  5748. SetWriteMode(XORPut);
  5749. GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
  5750. SetWriteMode(NormalPut);
  5751. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5752. ShowMouseCursor; { Show the mouse }
  5753. {$ENDIF}
  5754. Until NOT MouseEvent(Event, evMouseMove); { Finished moving }
  5755. State := PState; { Restore view state }
  5756. If (Owner<>Nil) Then
  5757. Owner^.ReDrawArea(Op1.X, Op1.Y, Op2.X, Op2.Y); { Redraw old area }
  5758. SetState(sfDragging, False); { Clr dragging flag }
  5759. DrawView; { Now redraw the view }
  5760. End Else Begin
  5761. GetBounds(SaveBounds); { Get current bounds }
  5762. Repeat
  5763. P := Origin; S := Size; { Set values }
  5764. KeyEvent(Event); { Get key event }
  5765. Case Event.KeyCode AND $FF00 Of
  5766. kbLeft: Change(-1, 0); { Move left }
  5767. kbRight: Change(1, 0); { Move right }
  5768. kbUp: Change(0, -1); { Move up }
  5769. kbDown: Change(0, 1); { Move down }
  5770. kbCtrlLeft: Change(-8, 0);
  5771. kbCtrlRight: Change(8, 0);
  5772. kbHome: Update(Limits.A.X, P.Y);
  5773. kbEnd: Update(Limits.B.X - S.X, P.Y);
  5774. kbPgUp: Update(P.X, Limits.A.Y);
  5775. kbPgDn: Update(P.X, Limits.B.Y - S.Y);
  5776. End;
  5777. MoveGrow(P, S); { Now move the view }
  5778. Until (Event.KeyCode = kbEnter) OR
  5779. (Event.KeyCode = kbEsc);
  5780. If (Event.KeyCode=kbEsc) Then Locate(SaveBounds);{ Restore original }
  5781. End;
  5782. SetState(sfDragging, False); { Clr dragging flag }
  5783. END;
  5784. FUNCTION TView.FontWidth: Integer;
  5785. BEGIN
  5786. FontWidth := SysFontWidth;
  5787. END;
  5788. FUNCTION TView.FontHeight: Integer;
  5789. BEGIN
  5790. FontHeight := SysFontHeight;
  5791. END;
  5792. {$IFNDEF OS_DOS}
  5793. {***************************************************************************}
  5794. { TView OBJECT WIN/NT ONLY METHODS }
  5795. {***************************************************************************}
  5796. {--TView--------------------------------------------------------------------}
  5797. { CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  5798. {---------------------------------------------------------------------------}
  5799. PROCEDURE TView.CreateWindowNow (CmdShow: Integer);
  5800. VAR Li: LongInt; S: String; Cp, Ct: Array[0..256] Of Char;
  5801. {$IFDEF OS_WINDOWS} VAR WndClass: TWndClass; {$ENDIF}
  5802. {$IFDEF OS_OS2} VAR P: Pointer; WndClass: ClassInfo; {$ENDIF}
  5803. BEGIN
  5804. If (HWindow = 0) Then Begin { Window not created }
  5805. S := GetClassName; { Fetch classname }
  5806. FillChar(Cp, SizeOf(Cp), #0); { Clear buffer }
  5807. Move(S[1], Cp, Length(S)); { Transfer classname }
  5808. S := GetClassText; { Fetch class text }
  5809. FillChar(Ct, SizeOf(Ct), #0); { Clear buffer }
  5810. Move(S[1], Ct, Length(S)); { Transfer class text }
  5811. If (GOptions AND goNativeClass = 0) AND { Not native class }
  5812. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5813. {$IFNDEF PPC_SPEED}
  5814. {$IFDEF PPC_FPC}
  5815. NOT GetClassInfo(HInstance, Cp, @WndClass)
  5816. {$ELSE}
  5817. NOT GetClassInfo(HInstance, Cp, WndClass)
  5818. {$ENDIF}
  5819. {$ELSE} { SPEEDSOFT SYBIL2+ }
  5820. NOT GetClassInfo(0, CString(Cp), WndClass)
  5821. {$ENDIF}
  5822. Then Begin { Class not registered }
  5823. WndClass.Style := CS_HRedraw OR CS_VReDraw OR
  5824. CS_DBLClks; { Class styles }
  5825. {$IFDEF PPC_SPEED}
  5826. WndClass.lpfnWndProc:= WndProc(GetMsgHandler); { Message handler }
  5827. {$ELSE}
  5828. Pointer(WndClass.lpfnWndProc) := GetMsgHandler;{ Message handler }
  5829. {$ENDIF}
  5830. WndClass.cbClsExtra := 0; { No extra data }
  5831. WndClass.cbWndExtra := 0; { No extra data }
  5832. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5833. WndClass.hInstance := 0;
  5834. WndClass.hIcon := Idi_Application; { Set icon }
  5835. {$ELSE}
  5836. WndClass.hInstance := HInstance; { Set instance }
  5837. WndClass.hIcon := LoadIcon(0, Idi_Application);{ Set icon }
  5838. {$ENDIF}
  5839. WndClass.hCursor := LoadCursor(0, Idc_Arrow); { Set cursor }
  5840. WndClass.hbrBackground := GetStockObject(
  5841. Null_Brush); { Class brush }
  5842. WndClass.lpszMenuName := Nil; { No menu }
  5843. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5844. WndClass.lpszClassName := @Cp; { Set class name }
  5845. {$ELSE} { OTHER COMPILERS }
  5846. WndClass.lpszClassName := Cp; { Set class name }
  5847. {$ENDIF}
  5848. {$IFDEF BIT_32} { 32 BIT CODE }
  5849. If (RegisterClass(WndClass) = 0)
  5850. {$ENDIF}
  5851. {$IFDEF BIT_16} { 16 BIT CODE }
  5852. If (RegisterClass(WndClass) = False)
  5853. {$ENDIF}
  5854. Then Begin
  5855. MessageBox(GetFocus, 'Can not Register Class',
  5856. 'UnKnown Error Cause?', mb_OK); { Failed to register }
  5857. Halt; { Halt on failure }
  5858. End;
  5859. End;
  5860. If (GOptions AND goNativeClass <> 0) Then
  5861. Li := 1 Else Li := 0;
  5862. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner window }
  5863. Then HWindow := CreateWindowEx(ExStyle,
  5864. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5865. CString(Cp), Ct, GetClassAttr OR ws_Child,
  5866. RawOrigin.X-Owner^.RawOrigin.X-Owner^.FrameSize,
  5867. RawOrigin.Y-Owner^.RawOrigin.Y-Owner^.CaptSize+Li,
  5868. RawSize.X+1,
  5869. RawSize.Y+1, Owner^.HWindow, GetClassId, 0, Nil)
  5870. {$ELSE}
  5871. Cp, Ct, GetClassAttr OR ws_Child,
  5872. RawOrigin.X-Owner^.RawOrigin.X-Owner^.FrameSize,
  5873. RawOrigin.Y-Owner^.RawOrigin.Y-Owner^.CaptSize+Li,
  5874. RawSize.X+1,
  5875. RawSize.Y+1, Owner^.HWindow, GetClassId, hInstance, Nil)
  5876. {$ENDIF}
  5877. Else HWindow := CreateWindowEx(ExStyle,
  5878. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5879. CString(Cp), Ct, GetClassAttr,
  5880. RawOrigin.X, RawOrigin.Y, RawSize.X+1, RawSize.Y+1,
  5881. AppWindow, GetClassId, 0, Nil); { Create the window }
  5882. {$ELSE}
  5883. Cp, Ct, GetClassAttr,
  5884. RawOrigin.X, RawOrigin.Y, RawSize.X+1, RawSize.Y+1,
  5885. AppWindow, GetClassId, hInstance, Nil); { Create the window }
  5886. {$ENDIF}
  5887. If (HWindow <> 0) Then Begin { Window created ok }
  5888. SendMessage(HWindow, WM_SetFont, DefGFVFont, 1);
  5889. Li := LongInt(@Self); { Address of self }
  5890. {$IFDEF BIT_16} { 16 BIT CODE }
  5891. SetProp(HWindow, ViewSeg, Li AND $FFFF0000
  5892. SHR 16); { Set seg property }
  5893. SetProp(HWindow, ViewOfs, Li AND $FFFF); { Set ofs propertry }
  5894. {$ENDIF}
  5895. {$IFDEF BIT_32} { 32 BIT CODE }
  5896. SetProp(HWindow, ViewPtr, Li ); { Set view property }
  5897. {$ENDIF}
  5898. If (CmdShow <> 0) Then
  5899. ShowWindow(HWindow, cmdShow); { Execute show cmd }
  5900. If (State AND sfVisible <> 0) Then Begin
  5901. UpdateWindow(HWindow); { Update the window }
  5902. BringWindowToTop(HWindow); { Bring window to top }
  5903. End;
  5904. If (State AND sfDisabled <> 0) Then
  5905. EnableWindow(HWindow, False); { Disable the window }
  5906. End;
  5907. {$ENDIF}
  5908. {$IFDEF OS_OS2} { OS2 CODE }
  5909. (WinQueryClassInfo(Anchor, Cp, WndClass) = False)
  5910. Then Begin { Class not registered }
  5911. P := GetMsgHandler; { Message handler }
  5912. If (WinRegisterClass(Anchor, Cp, P,
  5913. cs_SizeRedraw, SizeOf(Pointer))= False) { Register the class }
  5914. Then Begin
  5915. WinMessageBox(0, 0, 'Can not Register Class',
  5916. 'UnKnown Error Cause?', 0, mb_OK); { Failed to register }
  5917. Halt; { Halt on failure }
  5918. End;
  5919. End;
  5920. Li := GetClassAttr; { Class attributes }
  5921. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner window }
  5922. Then Begin
  5923. HWindow := WinCreateStdWindow(Owner^.Client,
  5924. 0, Li, Cp, Ct, lStyle, 0, 0, @Client);
  5925. If (HWindow <> 0) Then Begin { Window created ok }
  5926. Li := LongInt(@Self); { Address of self }
  5927. WinSetPresParam(Client, PP_User,
  5928. SizeOf(Pointer), @Li); { Hold as property }
  5929. WinSetWindowPos(HWindow, 0, RawOrigin.X-Owner^.RawOrigin.X,
  5930. (Owner^.RawOrigin.Y + Owner^.RawSize.Y) -
  5931. (RawOrigin.Y + RawSize.Y),
  5932. RawSize.X+1, RawSize.Y+1,
  5933. swp_Move + swp_Size + swp_Activate + swp_Show);
  5934. If (GOptions AND goNativeClass <> 0) Then Begin
  5935. WinSetOwner(Client, Owner^.Client);
  5936. End;
  5937. If (State AND sfDisabled <> 0) Then
  5938. WinEnableWindow(HWindow, False); { Disable the window }
  5939. End;
  5940. End Else Begin
  5941. HWindow := WinCreateStdWindow(HWND_Desktop,
  5942. 0, Li, Cp, Ct, lStyle, 0, 0, @Client);
  5943. If (HWindow <> 0) Then Begin { Window created ok }
  5944. Li := LongInt(@Self); { Address of self }
  5945. WinSetPresParam(Client, PP_User,
  5946. SizeOf(Pointer), @Li); { Hold as property }
  5947. WinSetWindowPos(HWindow, 0, RawOrigin.X,
  5948. WinQuerySysValue(hwnd_Desktop, sv_CyScreen)-RawSize.Y,
  5949. RawSize.X, RawSize.Y,
  5950. swp_Move + swp_Size + swp_Activate OR cmdShow);
  5951. End;
  5952. End;
  5953. {$ENDIF}
  5954. End;
  5955. END;
  5956. {$ENDIF}
  5957. {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
  5958. {Þ TScroller OBJECT METHODS Ý}
  5959. {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
  5960. PROCEDURE TScroller.ScrollDraw;
  5961. VAR D: TPoint;
  5962. BEGIN
  5963. If (HScrollBar<>Nil) Then D.X := HScrollBar^.Value
  5964. Else D.X := 0; { Horz scroll value }
  5965. If (VScrollBar<>Nil) Then D.Y := VScrollBar^.Value
  5966. Else D.Y := 0; { Vert scroll value }
  5967. If (D.X<>Delta.X) OR (D.Y<>Delta.Y) Then Begin { View has moved }
  5968. SetCursor(Cursor.X+Delta.X-D.X,
  5969. Cursor.Y+Delta.Y-D.Y); { Move the cursor }
  5970. Delta := D; { Set new delta }
  5971. If (DrawLock<>0) Then DrawFlag := True { Draw will need draw }
  5972. Else DrawView; { Redraw the view }
  5973. End;
  5974. END;
  5975. PROCEDURE TScroller.SetLimit (X, Y: Integer);
  5976. VAR PState: Word;
  5977. BEGIN
  5978. Limit.X := X; { Hold x limit }
  5979. Limit.Y := Y; { Hold y limit }
  5980. Inc(DrawLock); { Set draw lock }
  5981. If (HScrollBar<>Nil) Then Begin
  5982. PState := HScrollBar^.State; { Hold bar state }
  5983. HScrollBar^.State := PState AND NOT sfVisible; { Temp not visible }
  5984. HScrollBar^.SetParams(HScrollBar^.Value, 0,
  5985. X-Size.X, Size.X-1, HScrollBar^.ArStep); { Set horz scrollbar }
  5986. HScrollBar^.State := PState; { Restore bar state }
  5987. End;
  5988. If (VScrollBar<>Nil) Then Begin
  5989. PState := VScrollBar^.State; { Hold bar state }
  5990. VScrollBar^.State := PState AND NOT sfVisible; { Temp not visible }
  5991. VScrollBar^.SetParams(VScrollBar^.Value, 0,
  5992. Y-Size.Y, Size.Y-1, VScrollBar^.ArStep); { Set vert scrollbar }
  5993. VScrollBar^.State := PState; { Restore bar state }
  5994. End;
  5995. Dec(DrawLock); { Release draw lock }
  5996. CheckDraw; { Check need to draw }
  5997. END;
  5998. {***************************************************************************}
  5999. { TScroller OBJECT PRIVATE METHODS }
  6000. {***************************************************************************}
  6001. PROCEDURE TScroller.CheckDraw;
  6002. BEGIN
  6003. If (DrawLock = 0) AND DrawFlag Then Begin { Clear & draw needed }
  6004. DrawFlag := False; { Clear draw flag }
  6005. DrawView; { Draw now }
  6006. End;
  6007. END;
  6008. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6009. { TGroup OBJECT METHODS }
  6010. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6011. {--TGroup-------------------------------------------------------------------}
  6012. { Lock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
  6013. {---------------------------------------------------------------------------}
  6014. PROCEDURE TGroup.Lock;
  6015. BEGIN
  6016. If (Buffer <> Nil) OR (LockFlag <> 0)
  6017. Then Inc(LockFlag); { Increment count }
  6018. END;
  6019. {--TGroup-------------------------------------------------------------------}
  6020. { UnLock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
  6021. {---------------------------------------------------------------------------}
  6022. PROCEDURE TGroup.Unlock;
  6023. BEGIN
  6024. If (LockFlag <> 0) Then Begin
  6025. Dec(LockFlag); { Decrement count }
  6026. {If (LockFlag = 0) Then DrawView;} { Lock release draw }
  6027. End;
  6028. END;
  6029. PROCEDURE TWindow.DrawBorder;
  6030. VAR Fc, Bc: Byte; X, Y: Integer; S: String; ViewPort: ViewPortType;
  6031. BEGIN
  6032. {$IFDEF OS_DOS}
  6033. Fc := GetColor(2) AND $0F; { Foreground colour }
  6034. Bc := 9; { Background colour }
  6035. If (Options AND ofFramed<>0) Then Y := 1
  6036. Else Y := 0; { Initial value }
  6037. If (GOptions AND goThickFramed<>0) Then Inc(Y, 3); { Adjust position }
  6038. ClearArea(0, Y, RawSize.X, Y+FontHeight, Bc); { Clear background }
  6039. If (Title<>Nil) AND (GOptions AND goTitled<>0)
  6040. Then Begin { View has a title }
  6041. GetViewSettings(ViewPort);
  6042. X := (RawSize.X DIV 2); { Half way point }
  6043. X := X - (Length(Title^)*FontWidth) DIV 2; { Calc start point }
  6044. SetColor(Fc);
  6045. OutTextXY(RawOrigin.X+X-ViewPort.X1,
  6046. RawOrigin.Y+Y+1-ViewPort.Y1+2, Title^); { Write the title }
  6047. End;
  6048. If (Number>0) AND (Number<10) Then Begin { Valid number }
  6049. Str(Number, S); { Make number string }
  6050. SetColor(GetColor(2) AND $0F);
  6051. OutTextXY(RawOrigin.X+RawSize.X-2*FontWidth-ViewPort.X1,
  6052. RawOrigin.Y+Y+1-ViewPort.Y1+2, S); { Write number }
  6053. End;
  6054. If (Flags AND wfClose<>0) Then Begin { Close icon request }
  6055. SetColor(Fc);
  6056. OutTextXY(RawOrigin.X+Y+FontWidth-ViewPort.X1,
  6057. RawOrigin.Y+Y+1-ViewPort.Y1+2, '[*]'); { Write close icon }
  6058. End;
  6059. If (Flags AND wfZoom<>0) Then Begin
  6060. SetColor(GetColor(2) AND $0F);
  6061. OutTextXY(RawOrigin.X+RawSize.X-4*FontWidth-Y-ViewPort.X1,
  6062. RawOrigin.Y+Y+1-ViewPort.Y1+2, '['+#24+']'); { Write zoom icon }
  6063. End;
  6064. BiColorRectangle(Y+1, Y+1, RawSize.X-Y-1, Y+FontHeight,
  6065. White, DarkGray, False); { Draw 3d effect }
  6066. BiColorRectangle(Y+1, Y+1, RawSize.X-Y-2, Y+FontHeight-1,
  6067. White, DarkGray, False); { Draw 3d effect }
  6068. Inherited DrawBorder;
  6069. {$ENDIF}
  6070. END;
  6071. {***************************************************************************}
  6072. { INTERFACE ROUTINES }
  6073. {***************************************************************************}
  6074. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6075. { WINDOW MESSAGE ROUTINES }
  6076. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6077. {---------------------------------------------------------------------------}
  6078. { Message -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  6079. {---------------------------------------------------------------------------}
  6080. FUNCTION Message (Receiver: PView; What, Command: Word;
  6081. InfoPtr: Pointer): Pointer;
  6082. VAR Event: TEvent;
  6083. BEGIN
  6084. Message := Nil; { Preset nil }
  6085. If (Receiver <> Nil) Then Begin { Valid receiver }
  6086. Event.What := What; { Set what }
  6087. Event.Command := Command; { Set command }
  6088. Event.Id := 0; { Zero id field }
  6089. Event.Data := 0; { Zero data field }
  6090. Event.InfoPtr := InfoPtr; { Set info ptr }
  6091. Receiver^.HandleEvent(Event); { Pass to handler }
  6092. If (Event.What = evNothing) Then
  6093. Message := Event.InfoPtr; { Return handler }
  6094. End;
  6095. END;
  6096. {---------------------------------------------------------------------------}
  6097. { NewMessage -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Sep97 LdB }
  6098. {---------------------------------------------------------------------------}
  6099. FUNCTION NewMessage (P: PView; What, Command: Word; Id: Integer;
  6100. Data: Real; InfoPtr: Pointer): Pointer;
  6101. VAR Event: TEvent;
  6102. BEGIN
  6103. NewMessage := Nil; { Preset failure }
  6104. If (P <> Nil) Then Begin
  6105. Event.What := What; { Set what }
  6106. Event.Command := Command; { Set event command }
  6107. Event.Id := Id; { Set up Id }
  6108. Event.Data := Data; { Set up data }
  6109. Event.InfoPtr := InfoPtr; { Set up event ptr }
  6110. P^.HandleEvent(Event); { Send to view }
  6111. If (Event.What = evNothing) Then
  6112. NewMessage := Event.InfoPtr; { Return handler }
  6113. End;
  6114. END;
  6115. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6116. { NEW VIEW ROUTINES }
  6117. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6118. {---------------------------------------------------------------------------}
  6119. { CreateIdScrollBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Checked 22May97 LdB }
  6120. {---------------------------------------------------------------------------}
  6121. FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
  6122. VAR R: TRect; P: PScrollBar;
  6123. BEGIN
  6124. If Horz Then R.Assign(X, Y, X+Size, Y+1) Else { Horizontal bar }
  6125. R.Assign(X, Y, X+1, Y+Size); { Vertical bar }
  6126. P := New(PScrollBar, Init(R)); { Create scrollbar }
  6127. If (P <> Nil) Then Begin
  6128. P^.Id := Id; { Set scrollbar id }
  6129. P^.Options := P^.Options OR ofPostProcess; { Set post processing }
  6130. End;
  6131. CreateIdScrollBar := P; { Return scrollbar }
  6132. END;
  6133. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6134. { OBJECT REGISTRATION PROCEDURES }
  6135. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6136. {---------------------------------------------------------------------------}
  6137. { RegisterViews -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May97 LdB }
  6138. {---------------------------------------------------------------------------}
  6139. PROCEDURE RegisterViews;
  6140. BEGIN
  6141. RegisterType(RView); { Register views }
  6142. RegisterType(RFrame); { Register frame }
  6143. RegisterType(RScrollBar); { Register scrollbar }
  6144. RegisterType(RScroller); { Register scroller }
  6145. RegisterType(RListViewer); { Register listview }
  6146. RegisterType(RGroup); { Register group }
  6147. RegisterType(RWindow); { Register window }
  6148. END;
  6149. END.