views.pas 345 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676
  1. { $Id$ }
  2. {********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
  3. { }
  4. { System independent GRAPHICAL clone of VIEWS.PAS }
  5. { }
  6. { Interface Copyright (c) 1992 Borland International }
  7. { }
  8. { Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer }
  9. { [email protected] - primary e-mail address }
  10. { [email protected] - backup e-mail address }
  11. { }
  12. {****************[ THIS CODE IS FREEWARE ]*****************}
  13. { }
  14. { This sourcecode is released for the purpose to }
  15. { promote the pascal language on all platforms. You may }
  16. { redistribute it and/or modify with the following }
  17. { DISCLAIMER. }
  18. { }
  19. { This SOURCE CODE is distributed "AS IS" WITHOUT }
  20. { WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR }
  21. { ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
  22. { }
  23. {*****************[ SUPPORTED PLATFORMS ]******************}
  24. { 16 and 32 Bit compilers }
  25. { DOS - Turbo Pascal 7.0 + (16 Bit) }
  26. { DPMI - Turbo Pascal 7.0 + (16 Bit) }
  27. { - FPC 0.9912+ (GO32V2) (32 Bit) }
  28. { WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
  29. { - Delphi 1.0+ (16 Bit) }
  30. { WIN95/NT - Delphi 2.0+ (32 Bit) }
  31. { - Virtual Pascal 2.0+ (32 Bit) }
  32. { - Speedsoft Sybil 2.0+ (32 Bit) }
  33. { - FPC 0.9912+ (32 Bit) }
  34. { OS2 - Virtual Pascal 1.0+ (32 Bit) }
  35. { }
  36. {******************[ REVISION HISTORY ]********************}
  37. { Version Date Fix }
  38. { ------- --------- --------------------------------- }
  39. { 1.00 10 Nov 96 First multi platform release }
  40. { 1.10 29 Aug 97 Platform.inc sort added. }
  41. { 1.20 12 Sep 97 FPK pascal 0.92 conversion added. }
  42. { 1.30 10 Jun 98 Virtual pascal 2.0 code added. }
  43. { 1.40 10 Jul 99 Sybil 2.0 code added }
  44. { 1.41 03 Nov 99 FPC Windows support added. }
  45. { 1.50 26 Nov 99 Graphics stuff moved to GFVGraph }
  46. {**********************************************************}
  47. UNIT Views;
  48. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  49. INTERFACE
  50. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  51. {====Include file to sort compiler platform out =====================}
  52. {$I Platform.inc}
  53. {====================================================================}
  54. {==== Compiler directives ===========================================}
  55. {$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
  56. {$F+} { Force far calls - Used because of the FirstThat, ForNext ... }
  57. {$A+} { Word Align Data }
  58. {$B-} { Allow short circuit boolean evaluations }
  59. {$O+} { This unit may be overlaid }
  60. {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
  61. {$P-} { Normal string variables }
  62. {$N-} { No 80x87 code generation }
  63. {$E+} { Emulation is on }
  64. {$ENDIF}
  65. {$X+} { Extended syntax is ok }
  66. {$R-} { Disable range checking }
  67. {$S-} { Disable Stack Checking }
  68. {$I-} { Disable IO Checking }
  69. {$Q-} { Disable Overflow Checking }
  70. {$V-} { Turn off strict VAR strings }
  71. {====================================================================}
  72. USES
  73. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  74. {$IFNDEF PPC_SPEED} { NON SPEEDSOFT SYBIL2+ }
  75. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  76. Windows, { Standard unit }
  77. {$ELSE} { OTHER COMPILERS }
  78. WinTypes, WinProcs, { Stardard units }
  79. {$ENDIF}
  80. {$IFDEF PPC_BP} Win31, {$ENDIF} { Standard 3.1 unit }
  81. {$IFDEF PPC_DELPHI} Messages, {$ENDIF} { Delphi3+ unit }
  82. {$ELSE} { SPEEDSOFT SYBIL2+ }
  83. WinBase, WinDef, WinUser, WinGDI, { Standard unit }
  84. {$ENDIF}
  85. {$ENDIF}
  86. {$IFDEF OS_OS2} { OS2 CODE }
  87. OS2Def, OS2Base, OS2PMAPI, { Standard units }
  88. {$ENDIF}
  89. GFVGraph, { GFV standard unit }
  90. Common, Objects, Drivers; { GFV standard units }
  91. {***************************************************************************}
  92. { PUBLIC CONSTANTS }
  93. {***************************************************************************}
  94. {---------------------------------------------------------------------------}
  95. { TView STATE MASKS }
  96. {---------------------------------------------------------------------------}
  97. CONST
  98. sfVisible = $0001; { View visible mask }
  99. sfCursorVis = $0002; { Cursor visible }
  100. sfCursorIns = $0004; { Cursor insert mode }
  101. sfShadow = $0008; { View has shadow }
  102. sfActive = $0010; { View is active }
  103. sfSelected = $0020; { View is selected }
  104. sfFocused = $0040; { View is focused }
  105. sfDragging = $0080; { View is dragging }
  106. sfDisabled = $0100; { View is disabled }
  107. sfModal = $0200; { View is modal }
  108. sfDefault = $0400; { View is default }
  109. sfExposed = $0800; { View is exposed }
  110. sfIconised = $1000; { View is iconised }
  111. {---------------------------------------------------------------------------}
  112. { TView OPTION MASKS }
  113. {---------------------------------------------------------------------------}
  114. CONST
  115. ofSelectable = $0001; { View selectable }
  116. ofTopSelect = $0002; { Top selectable }
  117. ofFirstClick = $0004; { First click react }
  118. ofFramed = $0008; { View is framed }
  119. ofPreProcess = $0010; { Pre processes }
  120. ofPostProcess = $0020; { Post processes }
  121. ofBuffered = $0040; { View is buffered }
  122. ofTileable = $0080; { View is tileable }
  123. ofCenterX = $0100; { View centred on x }
  124. ofCenterY = $0200; { View centred on y }
  125. ofCentered = $0300; { View x,y centred }
  126. ofValidate = $0400; { View validates }
  127. ofVersion = $3000; { View TV version }
  128. ofVersion10 = $0000; { TV version 1 view }
  129. ofVersion20 = $1000; { TV version 2 view }
  130. ofGFVModeView = $4000; { View is in GFV mode }
  131. {---------------------------------------------------------------------------}
  132. { TView GROW MODE MASKS }
  133. {---------------------------------------------------------------------------}
  134. CONST
  135. gfGrowLoX = $01; { Left side grow }
  136. gfGrowLoY = $02; { Top side grow }
  137. gfGrowHiX = $04; { Right side grow }
  138. gfGrowHiY = $08; { Bottom side grow }
  139. gfGrowAll = $0F; { Grow on all sides }
  140. gfGrowRel = $10; { Grow relative }
  141. {---------------------------------------------------------------------------}
  142. { TView DRAG MODE MASKS }
  143. {---------------------------------------------------------------------------}
  144. CONST
  145. dmDragMove = $01; { Move view }
  146. dmDragGrow = $02; { Grow view }
  147. dmLimitLoX = $10; { Limit left side }
  148. dmLimitLoY = $20; { Limit top side }
  149. dmLimitHiX = $40; { Limit right side }
  150. dmLimitHiY = $80; { Limit bottom side }
  151. dmLimitAll = $F0; { Limit all sides }
  152. {---------------------------------------------------------------------------}
  153. { >> NEW << TView OPTION MASKS }
  154. {---------------------------------------------------------------------------}
  155. CONST
  156. goThickFramed = $0001; { Thick framed mask }
  157. goDrawFocus = $0002; { Draw focus mask }
  158. goTitled = $0004; { Draw titled mask }
  159. goTabSelect = $0008; { Tab selectable }
  160. goEveryKey = $0020; { Report every key }
  161. goEndModal = $0040; { End modal }
  162. goGraphView = $1000; { Raw graphic view }
  163. goGraphical = $2000; { Graphical view }
  164. goNativeClass = $4000; { Native class window }
  165. goNoDrawView = $8000; { View does not draw }
  166. {---------------------------------------------------------------------------}
  167. { >> NEW << TAB OPTION MASKS }
  168. {---------------------------------------------------------------------------}
  169. CONST
  170. tmTab = $01; { Tab move mask }
  171. tmShiftTab = $02; { Shift+tab move mask }
  172. tmEnter = $04; { Enter move mask }
  173. tmLeft = $08; { Left arrow move mask }
  174. tmRight = $10; { Right arrow move mask }
  175. tmUp = $20; { Up arrow move mask }
  176. tmDown = $40; { Down arrow move mask }
  177. {---------------------------------------------------------------------------}
  178. { >> NEW << VIEW DRAW MASKS }
  179. {---------------------------------------------------------------------------}
  180. CONST
  181. vdBackGnd = $01; { Draw backgound }
  182. vdInner = $02; { Draw inner detail }
  183. vdCursor = $04; { Draw cursor }
  184. vdBorder = $08; { Draw view border }
  185. vdFocus = $10; { Draw focus state }
  186. vdNoChild = $20; { Draw no children }
  187. {---------------------------------------------------------------------------}
  188. { TView HELP CONTEXTS }
  189. {---------------------------------------------------------------------------}
  190. CONST
  191. hcNoContext = 0; { No view context }
  192. hcDragging = 1; { No drag context }
  193. {---------------------------------------------------------------------------}
  194. { TWindow FLAG MASKS }
  195. {---------------------------------------------------------------------------}
  196. CONST
  197. wfMove = $01; { Window can move }
  198. wfGrow = $02; { Window can grow }
  199. wfClose = $04; { Window can close }
  200. wfZoom = $08; { Window can zoom }
  201. {---------------------------------------------------------------------------}
  202. { TWindow PALETTES }
  203. {---------------------------------------------------------------------------}
  204. CONST
  205. wpBlueWindow = 0; { Blue palette }
  206. wpCyanWindow = 1; { Cyan palette }
  207. wpGrayWindow = 2; { Gray palette }
  208. {---------------------------------------------------------------------------}
  209. { COLOUR PALETTES }
  210. {---------------------------------------------------------------------------}
  211. CONST
  212. CFrame = #1#1#2#2#3; { Frame palette }
  213. CScrollBar = #4#5#5; { Scrollbar palette }
  214. CScroller = #6#7; { Scroller palette }
  215. CListViewer = #26#26#27#28#29; { Listviewer palette }
  216. CBlueWindow = #8#9#10#11#12#13#14#15; { Blue window palette }
  217. CCyanWindow = #16#17#18#19#20#21#22#23; { Cyan window palette }
  218. CGrayWindow = #24#25#26#27#28#29#30#31; { Grey window palette }
  219. {---------------------------------------------------------------------------}
  220. { TScrollBar PART CODES }
  221. {---------------------------------------------------------------------------}
  222. CONST
  223. sbLeftArrow = 0; { Left arrow part }
  224. sbRightArrow = 1; { Right arrow part }
  225. sbPageLeft = 2; { Page left part }
  226. sbPageRight = 3; { Page right part }
  227. sbUpArrow = 4; { Up arrow part }
  228. sbDownArrow = 5; { Down arrow part }
  229. sbPageUp = 6; { Page up part }
  230. sbPageDown = 7; { Page down part }
  231. sbIndicator = 8; { Indicator part }
  232. {---------------------------------------------------------------------------}
  233. { TScrollBar OPTIONS FOR TWindow.StandardScrollBar }
  234. {---------------------------------------------------------------------------}
  235. CONST
  236. sbHorizontal = $0000; { Horz scrollbar }
  237. sbVertical = $0001; { Vert scrollbar }
  238. sbHandleKeyboard = $0002; { Handle keyboard }
  239. {---------------------------------------------------------------------------}
  240. { STANDARD COMMAND CODES }
  241. {---------------------------------------------------------------------------}
  242. CONST
  243. cmValid = 0; { Valid command }
  244. cmQuit = 1; { Quit command }
  245. cmError = 2; { Error command }
  246. cmMenu = 3; { Menu command }
  247. cmClose = 4; { Close command }
  248. cmZoom = 5; { Zoom command }
  249. cmResize = 6; { Resize command }
  250. cmNext = 7; { Next view command }
  251. cmPrev = 8; { Prev view command }
  252. cmHelp = 9; { Help command }
  253. cmOK = 10; { Okay command }
  254. cmCancel = 11; { Cancel command }
  255. cmYes = 12; { Yes command }
  256. cmNo = 13; { No command }
  257. cmDefault = 14; { Default command }
  258. cmCut = 20; { Clipboard cut cmd }
  259. cmCopy = 21; { Clipboard copy cmd }
  260. cmPaste = 22; { Clipboard paste cmd }
  261. cmUndo = 23; { Clipboard undo cmd }
  262. cmClear = 24; { Clipboard clear cmd }
  263. cmTile = 25; { Tile subviews cmd }
  264. cmCascade = 26; { Cascade subviews cmd }
  265. cmReceivedFocus = 50; { Received focus }
  266. cmReleasedFocus = 51; { Released focus }
  267. cmCommandSetChanged = 52; { Commands changed }
  268. cmScrollBarChanged = 53; { Scrollbar changed }
  269. cmScrollBarClicked = 54; { Scrollbar clicked on }
  270. cmSelectWindowNum = 55; { Select window }
  271. cmListItemSelected = 56; { Listview item select }
  272. cmNotify = 27;
  273. cmIdCommunicate = 28; { Communicate via id }
  274. cmIdSelect = 29; { Select via id }
  275. {---------------------------------------------------------------------------}
  276. { TWindow NUMBER CONSTANTS }
  277. {---------------------------------------------------------------------------}
  278. CONST
  279. wnNoNumber = 0; { Window has no num }
  280. MaxViewWidth = 132; { Max view width }
  281. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  282. {$IFDEF BIT_16} { WINDOWS 16 BIT CODE }
  283. {---------------------------------------------------------------------------}
  284. { WIN16 LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
  285. {---------------------------------------------------------------------------}
  286. CONST
  287. ViewSeg = 'TVWINSEG'+#0; { View segment label }
  288. ViewOfs = 'TVWINOFS'+#0; { View offset label }
  289. {$ENDIF}
  290. {$IFDEF BIT_32} { WINDOWS 32 BIT CODE }
  291. {---------------------------------------------------------------------------}
  292. { WIN32/NT LABEL CONSTANTS FOR WINDOW PROPERTY CALLS }
  293. {---------------------------------------------------------------------------}
  294. CONST
  295. ViewPtr = 'TVWINPTR'+#0; { View ptr label }
  296. {$ENDIF}
  297. {$ENDIF}
  298. {***************************************************************************}
  299. { PUBLIC TYPE DEFINITIONS }
  300. {***************************************************************************}
  301. {---------------------------------------------------------------------------}
  302. { TWindow Title string }
  303. {---------------------------------------------------------------------------}
  304. TYPE
  305. TTitleStr = String[80]; { Window title string }
  306. {---------------------------------------------------------------------------}
  307. { COMMAND SET RECORD }
  308. {---------------------------------------------------------------------------}
  309. TYPE
  310. TCommandSet = SET OF Byte; { Command set record }
  311. PCommandSet = ^TCommandSet; { Ptr to command set }
  312. {---------------------------------------------------------------------------}
  313. { PALETTE RECORD }
  314. {---------------------------------------------------------------------------}
  315. TYPE
  316. TPalette = String; { Palette record }
  317. PPalette = ^TPalette; { Pointer to palette }
  318. {---------------------------------------------------------------------------}
  319. { TDrawBuffer RECORD }
  320. {---------------------------------------------------------------------------}
  321. TYPE
  322. TDrawBuffer = Array [0..MaxViewWidth - 1] Of Word; { Draw buffer record }
  323. PDrawBuffer = ^TDrawBuffer; { Ptr to draw buffer }
  324. {---------------------------------------------------------------------------}
  325. { TVideoBuffer RECORD }
  326. {---------------------------------------------------------------------------}
  327. TYPE
  328. TVideoBuf = ARRAY [0..3999] of Word; { Video buffer }
  329. PVideoBuf = ^TVideoBuf; { Pointer to buffer }
  330. {---------------------------------------------------------------------------}
  331. { TComplexArea RECORD }
  332. {---------------------------------------------------------------------------}
  333. TYPE
  334. PComplexArea = ^TComplexArea; { Complex area }
  335. TComplexArea = PACKED RECORD
  336. X1, Y1 : Integer; { Top left corner }
  337. X2, Y2 : Integer; { Lower right corner }
  338. NextArea: PComplexArea; { Next area pointer }
  339. END;
  340. {***************************************************************************}
  341. { PUBLIC OBJECT DEFINITIONS }
  342. {***************************************************************************}
  343. TYPE
  344. PGroup = ^TGroup; { Pointer to group }
  345. {---------------------------------------------------------------------------}
  346. { TView OBJECT - ANCESTOR VIEW OBJECT }
  347. {---------------------------------------------------------------------------}
  348. PView = ^TView;
  349. TView = OBJECT (TObject)
  350. GrowMode : Byte; { View grow mode }
  351. DragMode : Byte; { View drag mode }
  352. DrawMask : Byte; { Draw masks }
  353. TabMask : Byte; { Tab move masks }
  354. ColourOfs: Integer; { View palette offset }
  355. HelpCtx : Word; { View help context }
  356. State : Word; { View state masks }
  357. Options : Word; { View options masks }
  358. EventMask: Word; { View event masks }
  359. GOptions : Word; { Graphics options }
  360. Origin : TPoint; { View origin }
  361. Size : TPoint; { View size }
  362. Cursor : TPoint; { Cursor position }
  363. RawOrigin: TPoint; { View raw origin }
  364. RawSize : TPoint; { View raw size }
  365. Next : PView; { Next peerview }
  366. Owner : PGroup; { Owner group }
  367. HoldLimit: PComplexArea; { Hold limit values }
  368. RevCol : Boolean;
  369. {$IFDEF OS_WINDOWS} { WIN/NT DATA ONLY }
  370. ExStyle : LongInt; { Extended style }
  371. Dc : HDc; { Device context }
  372. {$ENDIF}
  373. {$IFDEF OS_OS2} { OS2 DATA ONLY }
  374. lStyle : LongInt; { Style }
  375. Client : HWnd; { Client handle }
  376. Ps : HPs; { Paint structure }
  377. {$ENDIF}
  378. {$IFNDEF OS_DOS} { WIN/NT/OS2 DATA ONLY }
  379. FrameSize: Integer; { Frame size (X) }
  380. CaptSize : Integer; { Caption size (Y) }
  381. HWindow : HWnd; { Window handle }
  382. {$ENDIF}
  383. CONSTRUCTOR Init (Var Bounds: TRect);
  384. CONSTRUCTOR Load (Var S: TStream);
  385. DESTRUCTOR Done; Virtual;
  386. FUNCTION Prev: PView;
  387. FUNCTION Execute: Word; Virtual;
  388. FUNCTION Focus: Boolean;
  389. FUNCTION DataSize: Word; Virtual;
  390. FUNCTION TopView: PView;
  391. FUNCTION PrevView: PView;
  392. FUNCTION NextView: PView;
  393. FUNCTION GetHelpCtx: Word; Virtual;
  394. FUNCTION EventAvail: Boolean;
  395. FUNCTION GetPalette: PPalette; Virtual;
  396. FUNCTION GetColor (Color: Word): Word;
  397. FUNCTION Valid (Command: Word): Boolean; Virtual;
  398. FUNCTION GetState (AState: Word): Boolean;
  399. FUNCTION TextWidth (Txt: String): Integer;
  400. FUNCTION MouseInView (Point: TPoint): Boolean;
  401. FUNCTION CommandEnabled (Command: Word): Boolean;
  402. FUNCTION OverLapsArea (X1, Y1, X2, Y2: Integer): Boolean;
  403. FUNCTION MouseEvent (Var Event: TEvent; Mask: Word): Boolean;
  404. PROCEDURE Hide;
  405. PROCEDURE Show;
  406. PROCEDURE Draw; Virtual;
  407. PROCEDURE Select;
  408. PROCEDURE Awaken; Virtual;
  409. PROCEDURE DrawView;
  410. PROCEDURE MakeFirst;
  411. PROCEDURE DrawFocus; Virtual;
  412. PROCEDURE DrawCursor; Virtual;
  413. PROCEDURE DrawBorder; Virtual;
  414. PROCEDURE HideCursor;
  415. PROCEDURE ShowCursor;
  416. PROCEDURE BlockCursor;
  417. PROCEDURE NormalCursor;
  418. PROCEDURE FocusFromTop; Virtual;
  419. PROCEDURE SetViewLimits;
  420. PROCEDURE DrawBackGround; Virtual;
  421. PROCEDURE ReleaseViewLimits;
  422. PROCEDURE MoveTo (X, Y: Integer);
  423. PROCEDURE GrowTo (X, Y: Integer);
  424. PROCEDURE SetDrawMask (Mask: Byte);
  425. PROCEDURE EndModal (Command: Word); Virtual;
  426. PROCEDURE SetCursor (X, Y: Integer);
  427. PROCEDURE PutInFrontOf (Target: PView);
  428. PROCEDURE DisplaceBy (Dx, Dy: Integer); Virtual;
  429. PROCEDURE SetCommands (Commands: TCommandSet);
  430. PROCEDURE ReDrawArea (X1, Y1, X2, Y2: Integer);
  431. PROCEDURE EnableCommands (Commands: TCommandSet);
  432. PROCEDURE DisableCommands (Commands: TCommandSet);
  433. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  434. PROCEDURE SetCmdState (Commands: TCommandSet; Enable: Boolean);
  435. PROCEDURE GetData (Var Rec); Virtual;
  436. PROCEDURE SetData (Var Rec); Virtual;
  437. PROCEDURE Store (Var S: TStream);
  438. PROCEDURE Locate (Var Bounds: TRect);
  439. PROCEDURE KeyEvent (Var Event: TEvent);
  440. PROCEDURE GetEvent (Var Event: TEvent); Virtual;
  441. PROCEDURE PutEvent (Var Event: TEvent); Virtual;
  442. PROCEDURE GetExtent (Var Extent: TRect);
  443. PROCEDURE GetBounds (Var Bounds: TRect);
  444. PROCEDURE SetBounds (Var Bounds: TRect);
  445. PROCEDURE GetClipRect (Var Clip: TRect);
  446. PROCEDURE ClearEvent (Var Event: TEvent);
  447. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  448. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  449. PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual;
  450. PROCEDURE GetCommands (Var Commands: TCommandSet);
  451. PROCEDURE GetPeerViewPtr (Var S: TStream; Var P);
  452. PROCEDURE PutPeerViewPtr (Var S: TStream; P: PView);
  453. PROCEDURE CalcBounds (Var Bounds: TRect; Delta: TPoint); Virtual;
  454. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  455. FUNCTION GetClassId: LongInt; Virtual;
  456. FUNCTION GetClassName: String; Virtual;
  457. FUNCTION GetClassText: String; Virtual;
  458. FUNCTION GetClassAttr: LongInt; Virtual;
  459. FUNCTION GetNotifyCmd: LongInt; Virtual;
  460. FUNCTION GetMsgHandler: Pointer; Virtual;
  461. {$ENDIF}
  462. FUNCTION Exposed: Boolean; { This needs help!!!!! }
  463. PROCEDURE GraphLine (X1, Y1, X2, Y2: Integer; Colour: Byte);
  464. PROCEDURE GraphRectangle (X1, Y1, X2, Y2: Integer; Colour: Byte);
  465. PROCEDURE ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
  466. PROCEDURE GraphArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad: Integer;
  467. Colour: Byte);
  468. PROCEDURE FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
  469. Colour: Byte);
  470. PROCEDURE BicolorRectangle (X1, Y1, X2, Y2: Integer; Light, Dark: Byte;
  471. Down: Boolean);
  472. PROCEDURE WriteBuf (X, Y, W, H: Integer; Var Buf);
  473. PROCEDURE WriteLine (X, Y, W, H: Integer; Var Buf);
  474. PROCEDURE MakeLocal (Source: TPoint; Var Dest: TPoint);
  475. PROCEDURE MakeGlobal (Source: TPoint; Var Dest: TPoint);
  476. PROCEDURE WriteStr (X, Y: Integer; Str: String; Color: Byte);
  477. PROCEDURE WriteChar (X, Y: Integer; C: Char; Color: Byte;
  478. Count: Integer);
  479. PROCEDURE DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
  480. MinSize, MaxSize: TPoint);
  481. FUNCTION FontWidth: Integer;
  482. FUNCTION Fontheight: Integer;
  483. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  484. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  485. {$ENDIF}
  486. END;
  487. SelectMode = (NormalSelect, EnterSelect, LeaveSelect);
  488. {---------------------------------------------------------------------------}
  489. { TGroup OBJECT - GROUP OBJECT ANCESTOR }
  490. {---------------------------------------------------------------------------}
  491. TGroup = OBJECT (TView)
  492. Phase : (phFocused, phPreProcess, phPostProcess);
  493. EndState: Word; { Modal result }
  494. Current : PView; { Selected subview }
  495. Last : PView; { 1st view inserted }
  496. Buffer : PVideoBuf; { Speed up buffer }
  497. CONSTRUCTOR Init (Var Bounds: TRect);
  498. CONSTRUCTOR Load (Var S: TStream);
  499. DESTRUCTOR Done; Virtual;
  500. FUNCTION First: PView;
  501. FUNCTION Execute: Word; Virtual;
  502. FUNCTION GetHelpCtx: Word; Virtual;
  503. FUNCTION DataSize: Word; Virtual;
  504. FUNCTION ExecView (P: PView): Word; Virtual;
  505. FUNCTION FirstThat (P: Pointer): PView;
  506. FUNCTION Valid (Command: Word): Boolean; Virtual;
  507. FUNCTION FocusNext (Forwards: Boolean): Boolean;
  508. PROCEDURE Draw; Virtual;
  509. PROCEDURE Lock;
  510. PROCEDURE UnLock;
  511. PROCEDURE Awaken; Virtual;
  512. PROCEDURE ReDraw;
  513. PROCEDURE SelectDefaultView;
  514. PROCEDURE Insert (P: PView);
  515. PROCEDURE Delete (P: PView);
  516. PROCEDURE ForEach (P: Pointer); Virtual;
  517. PROCEDURE EndModal (Command: Word); Virtual;
  518. PROCEDURE DisplaceBy (Dx, Dy: Integer); Virtual;
  519. PROCEDURE SelectNext (Forwards: Boolean);
  520. PROCEDURE InsertBefore (P, Target: PView);
  521. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  522. PROCEDURE GetData (Var Rec); Virtual;
  523. PROCEDURE SetData (Var Rec); Virtual;
  524. PROCEDURE Store (Var S: TStream);
  525. PROCEDURE EventError (Var Event: TEvent); Virtual;
  526. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  527. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  528. PROCEDURE GetSubViewPtr (Var S: TStream; Var P);
  529. PROCEDURE PutSubViewPtr (Var S: TStream; P: PView);
  530. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  531. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  532. {$ENDIF}
  533. PRIVATE
  534. LockFlag: Byte;
  535. Clip : TRect;
  536. FUNCTION IndexOf (P: PView): Integer;
  537. FUNCTION FindNext (Forwards: Boolean): PView;
  538. FUNCTION FirstMatch (AState: Word; AOptions: Word): PView;
  539. PROCEDURE ResetCurrent;
  540. PROCEDURE RemoveView (P: PView);
  541. PROCEDURE InsertView (P, Target: PView);
  542. PROCEDURE SetCurrent (P: PView; Mode: SelectMode);
  543. END;
  544. {---------------------------------------------------------------------------}
  545. { TFrame OBJECT - FRAME VIEW OBJECT }
  546. {---------------------------------------------------------------------------}
  547. TYPE
  548. TFrame = OBJECT (TView)
  549. CONSTRUCTOR Init (Var Bounds: TRect);
  550. FUNCTION GetPalette: PPalette; Virtual;
  551. END;
  552. PFrame = ^TFrame;
  553. {---------------------------------------------------------------------------}
  554. { TScrollBar OBJECT - SCROLL BAR OBJECT }
  555. {---------------------------------------------------------------------------}
  556. TYPE
  557. TScrollChars = Array [0..4] of Char;
  558. TScrollBar = OBJECT (TView)
  559. Value : Integer; { Scrollbar value }
  560. Min : Integer; { Scrollbar minimum }
  561. Max : Integer; { Scrollbar maximum }
  562. PgStep: Integer; { One page step }
  563. ArStep: Integer; { One range step }
  564. Id : Integer; { Scrollbar ID }
  565. CONSTRUCTOR Init (Var Bounds: TRect);
  566. CONSTRUCTOR Load (Var S: TStream);
  567. FUNCTION GetPalette: PPalette; Virtual;
  568. FUNCTION ScrollStep (Part: Integer): Integer; Virtual;
  569. PROCEDURE Draw; Virtual;
  570. PROCEDURE ScrollDraw; Virtual;
  571. PROCEDURE DrawBackGround; Virtual;
  572. PROCEDURE SetValue (AValue: Integer);
  573. PROCEDURE SetRange (AMin, AMax: Integer);
  574. PROCEDURE SetStep (APgStep, AArStep: Integer);
  575. PROCEDURE SetParams (AValue, AMin, AMax, APgStep, AArStep: Integer);
  576. PROCEDURE Store (Var S: TStream);
  577. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  578. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  579. FUNCTION GetClassName: String; Virtual;
  580. FUNCTION GetClassAttr: LongInt; Virtual;
  581. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  582. {$ENDIF}
  583. PRIVATE
  584. Chars: TScrollChars; { Scrollbar chars }
  585. FUNCTION GetPos: Integer;
  586. FUNCTION GetSize: Integer;
  587. PROCEDURE DrawPos (Pos: Integer);
  588. PROCEDURE ClearPos (Pos: Integer);
  589. END;
  590. PScrollBar = ^TScrollBar;
  591. {---------------------------------------------------------------------------}
  592. { TScroller OBJECT - SCROLLING VIEW ANCESTOR }
  593. {---------------------------------------------------------------------------}
  594. TYPE
  595. TScroller = OBJECT (TView)
  596. Delta : TPoint;
  597. Limit : TPoint;
  598. HScrollBar: PScrollBar; { Horz scroll bar }
  599. VScrollBar: PScrollBar; { Vert scroll bar }
  600. CONSTRUCTOR Init (Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  601. CONSTRUCTOR Load (Var S: TStream);
  602. FUNCTION GetPalette: PPalette; Virtual;
  603. PROCEDURE ScrollDraw; Virtual;
  604. PROCEDURE SetLimit (X, Y: Integer);
  605. PROCEDURE ScrollTo (X, Y: Integer);
  606. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  607. PROCEDURE Store (Var S: TStream);
  608. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  609. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  610. PRIVATE
  611. DrawFlag: Boolean;
  612. DrawLock: Byte;
  613. PROCEDURE CheckDraw;
  614. END;
  615. PScroller = ^TScroller;
  616. {---------------------------------------------------------------------------}
  617. { TListViewer OBJECT - LIST VIEWER OBJECT }
  618. {---------------------------------------------------------------------------}
  619. TYPE
  620. TListViewer = OBJECT (TView)
  621. NumCols : Integer; { Number of columns }
  622. TopItem : Integer; { Top most item }
  623. Focused : Integer; { Focused item }
  624. Range : Integer; { Range of listview }
  625. HScrollBar: PScrollBar; { Horz scrollbar }
  626. VScrollBar: PScrollBar; { Vert scrollbar }
  627. CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Word; AHScrollBar,
  628. AVScrollBar: PScrollBar);
  629. CONSTRUCTOR Load (Var S: TStream);
  630. FUNCTION GetPalette: PPalette; Virtual;
  631. FUNCTION IsSelected (Item: Integer): Boolean; Virtual;
  632. FUNCTION GetText (Item: Integer; MaxLen: Integer): String; Virtual;
  633. PROCEDURE DrawFocus; Virtual;
  634. PROCEDURE DrawBackGround; Virtual;
  635. PROCEDURE FocusItem (Item: Integer); Virtual;
  636. PROCEDURE SetTopItem (Item: Integer);
  637. PROCEDURE SetRange (ARange: Integer);
  638. PROCEDURE SelectItem (Item: Integer); Virtual;
  639. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  640. PROCEDURE Store (Var S: TStream);
  641. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  642. PROCEDURE ChangeBounds (Var Bounds: TRect); Virtual;
  643. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  644. FUNCTION GetNotifyCmd: LongInt; Virtual;
  645. FUNCTION GetClassName: String; Virtual;
  646. FUNCTION GetClassAttr: LongInt; Virtual;
  647. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  648. {$ENDIF}
  649. PRIVATE
  650. PROCEDURE FocusItemNum (Item: Integer); Virtual;
  651. END;
  652. PListViewer = ^TListViewer;
  653. {---------------------------------------------------------------------------}
  654. { TWindow OBJECT - WINDOW OBJECT ANCESTOR }
  655. {---------------------------------------------------------------------------}
  656. TYPE
  657. TWindow = OBJECT (TGroup)
  658. Flags : Byte; { Window flags }
  659. Number : Integer; { Window number }
  660. Palette : Integer; { Window palette }
  661. ZoomRect: TRect; { Zoom rectangle }
  662. Frame : PFrame; { Frame view object }
  663. Title : PString; { Title string }
  664. CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
  665. CONSTRUCTOR Load (Var S: TStream);
  666. DESTRUCTOR Done; Virtual;
  667. FUNCTION GetPalette: PPalette; Virtual;
  668. FUNCTION GetTitle (MaxSize: Integer): TTitleStr; Virtual;
  669. FUNCTION StandardScrollBar (AOptions: Word): PScrollBar;
  670. PROCEDURE Zoom; Virtual;
  671. PROCEDURE Close; Virtual;
  672. PROCEDURE InitFrame; Virtual;
  673. PROCEDURE DrawBorder; Virtual;
  674. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  675. PROCEDURE Store (Var S: TStream);
  676. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  677. PROCEDURE SizeLimits (Var Min, Max: TPoint); Virtual;
  678. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  679. FUNCTION GetClassText: String; Virtual;
  680. FUNCTION GetClassAttr: LongInt; Virtual;
  681. {$ENDIF}
  682. END;
  683. PWindow = ^TWindow;
  684. {***************************************************************************}
  685. { INTERFACE ROUTINES }
  686. {***************************************************************************}
  687. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  688. { WINDOW MESSAGE ROUTINES }
  689. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  690. {-Message------------------------------------------------------------
  691. Message sets up an event record and calls Receiver^.HandleEvent to
  692. handle the event. Message returns nil if Receiver is nil, or if
  693. the event is not handled successfully.
  694. 12Sep97 LdB
  695. ---------------------------------------------------------------------}
  696. FUNCTION Message (Receiver: PView; What, Command: Word;
  697. InfoPtr: Pointer): Pointer;
  698. {-NewMessage---------------------------------------------------------
  699. NewMessage sets up an event record including the new fields and calls
  700. Receiver^.HandleEvent to handle the event. Message returns nil if
  701. Receiver is nil, or if the event is not handled successfully.
  702. 19Sep97 LdB
  703. ---------------------------------------------------------------------}
  704. FUNCTION NewMessage (P: PView; What, Command: Word; Id: Integer; Data: Real;
  705. InfoPtr: Pointer): Pointer;
  706. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  707. { VIEW OBJECT REGISTRATION ROUTINES }
  708. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  709. {-RegisterViews------------------------------------------------------
  710. This registers all the view type objects used in this unit.
  711. 11Aug99 LdB
  712. ---------------------------------------------------------------------}
  713. PROCEDURE RegisterViews;
  714. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  715. { NEW VIEW ROUTINES }
  716. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  717. {-CreateIdScrollBar--------------------------------------------------
  718. Creates and scrollbar object of the given size and direction and sets
  719. the scrollbar id number.
  720. 22Sep97 LdB
  721. ---------------------------------------------------------------------}
  722. FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
  723. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  724. { NEW WIN/NT/OS2 VERSION SPECIFIC INTERFACE ROUTINES }
  725. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  726. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  727. {-TvViewMsgHandler---------------------------------------------------
  728. This is the default WIN/NT handler for TView objects. Descendant
  729. objects may need to call back to this handler so it must be provided
  730. on the interface.
  731. 11Aug99 LdB
  732. ---------------------------------------------------------------------}
  733. FUNCTION TvViewMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
  734. lParam: LongInt): LongInt;
  735. {$IFDEF BIT_16} EXPORT; {$ENDIF}
  736. {$IFDEF BIT_32} {$IFDEF PPC_SPEED} CDECL; {$ELSE} STDCALL; {$ENDIF} {$ENDIF}
  737. {$ENDIF}
  738. {$IFDEF OS_OS2} { OS2 CODE }
  739. {-TvViewMsgHandler---------------------------------------------------
  740. This is the default OS2 handler for TView objects. Descendant objects
  741. may need to call back to this handler so it must be provided on the
  742. interface.
  743. 11Aug99 LdB
  744. ---------------------------------------------------------------------}
  745. FUNCTION TvViewMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult;
  746. CDECL; EXPORT;
  747. {$ENDIF}
  748. {***************************************************************************}
  749. { INITIALIZED PUBLIC VARIABLES }
  750. {***************************************************************************}
  751. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  752. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  753. TYPE TColorRef = LongInt; { TColorRef defined }
  754. {$ENDIF}
  755. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  756. TYPE
  757. TColorRef = LongInt; { TColorRef defined }
  758. TPaintStruct = PaintStruct; { TPaintStruct define }
  759. TWindowPos = WindowPos; { TWindowPos defined }
  760. TSize = Size; { TSize defined }
  761. TWndClass = WndClass; { TWndClass defined }
  762. {$ENDIF}
  763. {---------------------------------------------------------------------------}
  764. { INITIALIZED WIN/NT VARIABLES }
  765. {---------------------------------------------------------------------------}
  766. CONST
  767. ColRef: Array [0..15] Of TColorRef = { Standard colour refs }
  768. (rgb_Black, rgb_Blue, rgb_Green, rgb_Cyan,
  769. rgb_Red, rgb_Magenta, rgb_Brown, rgb_LightGray,
  770. rgb_DarkGray, rgb_LightBlue, rgb_LightGreen,
  771. rgb_LightCyan, rgb_LightRed, rgb_LightMagenta,
  772. rgb_Yellow, rgb_White);
  773. ColBrush: Array [0..15] Of HBrush =
  774. (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  775. ColPen: Array [0..15] Of HPen =
  776. (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  777. {$ENDIF}
  778. {$IFDEF OS_OS2} { OS2 CODE }
  779. {---------------------------------------------------------------------------}
  780. { INITIALIZED OS2 VARIABLES }
  781. {---------------------------------------------------------------------------}
  782. CONST
  783. ColRef: Array [0..15] Of LongInt =
  784. (clr_Black, clr_DarkBlue, clr_DarkGreen, clr_DarkCyan,
  785. clr_DarkRed, clr_DarkPink, clr_Brown, clr_PaleGray,
  786. clr_DarkGray, clr_Blue, clr_Green, clr_Cyan,
  787. clr_Red, clr_Pink, clr_Yellow, clr_White);
  788. {$ENDIF}
  789. {---------------------------------------------------------------------------}
  790. { INITIALIZED DOS/DPMI/WIN/NT/OS2 VARIABLES }
  791. {---------------------------------------------------------------------------}
  792. CONST
  793. UseNativeClasses: Boolean = True; { Native class modes }
  794. CommandSetChanged: Boolean = False; { Command change flag }
  795. ShowMarkers: Boolean = False; { Show marker state }
  796. ErrorAttr: Byte = $CF; { Error colours }
  797. PositionalEvents: Word = evMouse; { Positional defined }
  798. FocusedEvents: Word = evKeyboard + evCommand; { Focus defined }
  799. MinWinSize: TPoint = (X: 16; Y: 6); { Minimum window size }
  800. ShadowSize: TPoint = (X: 2; Y: 1); { Shadow sizes }
  801. ShadowAttr: Byte = $08; { Shadow attribute }
  802. { Characters used for drawing selected and default items in }
  803. { monochrome color sets }
  804. SpecialChars: Array [0..5] Of Char = (#175, #174, #26, #27, ' ', ' ');
  805. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  806. { STREAM REGISTRATION RECORDS }
  807. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  808. {---------------------------------------------------------------------------}
  809. { TView STREAM REGISTRATION }
  810. {---------------------------------------------------------------------------}
  811. CONST
  812. RView: TStreamRec = (
  813. ObjType: 1; { Register id = 1 }
  814. {$IFDEF BP_VMTLink}
  815. VmtLink: Ofs(TypeOf(TView)^); { BP style VMT link }
  816. {$ELSE}
  817. VmtLink: TypeOf(TView); { Alt style VMT link }
  818. {$ENDIF}
  819. Load: @TView.Load; { Object load method }
  820. Store: @TView.Store { Object store method }
  821. );
  822. {---------------------------------------------------------------------------}
  823. { TFrame STREAM REGISTRATION }
  824. {---------------------------------------------------------------------------}
  825. CONST
  826. RFrame: TStreamRec = (
  827. ObjType: 2; { Register id = 2 }
  828. {$IFDEF BP_VMTLink}
  829. VmtLink: Ofs(TypeOf(TFrame)^); { BP style VMT link }
  830. {$ELSE}
  831. VmtLink: TypeOf(TFrame); { Alt style VMT link }
  832. {$ENDIF}
  833. Load: @TFrame.Load; { Frame load method }
  834. Store: @TFrame.Store { Frame store method }
  835. );
  836. {---------------------------------------------------------------------------}
  837. { TScrollBar STREAM REGISTRATION }
  838. {---------------------------------------------------------------------------}
  839. CONST
  840. RScrollBar: TStreamRec = (
  841. ObjType: 3; { Register id = 3 }
  842. {$IFDEF BP_VMTLink}
  843. VmtLink: Ofs(TypeOf(TScrollBar)^); { BP style VMT link }
  844. {$ELSE}
  845. VmtLink: TypeOf(TScrollBar); { Alt style VMT link }
  846. {$ENDIF}
  847. Load: @TScrollBar.Load; { Object load method }
  848. Store: @TScrollBar.Store { Object store method }
  849. );
  850. {---------------------------------------------------------------------------}
  851. { TScroller STREAM REGISTRATION }
  852. {---------------------------------------------------------------------------}
  853. CONST
  854. RScroller: TStreamRec = (
  855. ObjType: 4; { Register id = 4 }
  856. {$IFDEF BP_VMTLink}
  857. VmtLink: Ofs(TypeOf(TScroller)^); { BP style VMT link }
  858. {$ELSE}
  859. VmtLink: TypeOf(TScroller); { Alt style VMT link }
  860. {$ENDIF}
  861. Load: @TScroller.Load; { Object load method }
  862. Store: @TScroller.Store { Object store method }
  863. );
  864. {---------------------------------------------------------------------------}
  865. { TListViewer STREAM REGISTRATION }
  866. {---------------------------------------------------------------------------}
  867. CONST
  868. RListViewer: TStreamRec = (
  869. ObjType: 5; { Register id = 5 }
  870. {$IFDEF BP_VMTLink}
  871. VmtLink: Ofs(TypeOf(TListViewer)^); { BP style VMT link }
  872. {$ELSE}
  873. VmtLink: TypeOf(TListViewer); { Alt style VMT link }
  874. {$ENDIF}
  875. Load: @TListViewer.Load; { Object load method }
  876. Store: @TLIstViewer.Store { Object store method }
  877. );
  878. {---------------------------------------------------------------------------}
  879. { TGroup STREAM REGISTRATION }
  880. {---------------------------------------------------------------------------}
  881. CONST
  882. RGroup: TStreamRec = (
  883. ObjType: 6; { Register id = 6 }
  884. {$IFDEF BP_VMTLink}
  885. VmtLink: Ofs(TypeOf(TGroup)^); { BP style VMT link }
  886. {$ELSE}
  887. VmtLink: TypeOf(TGroup); { Alt style VMT link }
  888. {$ENDIF}
  889. Load: @TGroup.Load; { Object load method }
  890. Store: @TGroup.Store { Object store method }
  891. );
  892. {---------------------------------------------------------------------------}
  893. { TWindow STREAM REGISTRATION }
  894. {---------------------------------------------------------------------------}
  895. CONST
  896. RWindow: TStreamRec = (
  897. ObjType: 7; { Register id = 7 }
  898. {$IFDEF BP_VMTLink}
  899. VmtLink: Ofs(TypeOf(TWindow)^); { BP style VMT link }
  900. {$ELSE}
  901. VmtLink: TypeOf(TWindow); { Alt style VMT link }
  902. {$ENDIF}
  903. Load: @TWindow.Load; { Object load method }
  904. Store: @TWindow.Store { Object store method }
  905. );
  906. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  907. IMPLEMENTATION
  908. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  909. {***************************************************************************}
  910. { PRIVATE CONSTANT DEFINITIONS }
  911. {***************************************************************************}
  912. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  913. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  914. CONST WM_Notify = $004E; { Value was left out }
  915. {$ENDIF}
  916. {$ENDIF}
  917. {***************************************************************************}
  918. { PRIVATE TYPE DEFINITIONS }
  919. {***************************************************************************}
  920. {---------------------------------------------------------------------------}
  921. { TFixupList DEFINITION }
  922. {---------------------------------------------------------------------------}
  923. TYPE
  924. TFixupList = ARRAY [1..4096] Of Pointer; { Fix up ptr array }
  925. PFixupList = ^TFixupList; { Ptr to fix up list }
  926. {***************************************************************************}
  927. { PRIVATE INITIALIZED VARIABLES }
  928. {***************************************************************************}
  929. {---------------------------------------------------------------------------}
  930. { INITIALIZED DOS/DPMI/WIN/NT/OS2 PRIVATE VARIABLES }
  931. {---------------------------------------------------------------------------}
  932. CONST
  933. TheTopView : PView = Nil; { Top focused view }
  934. LimitsLocked: PView = Nil; { View locking limits }
  935. OwnerGroup : PGroup = Nil; { Used for loading }
  936. FixupList : PFixupList = Nil; { Used for loading }
  937. CurCommandSet: TCommandSet = ([0..255] -
  938. [cmZoom, cmClose, cmResize, cmNext, cmPrev]); { All active but these }
  939. {***************************************************************************}
  940. { PRIVATE INTERNAL ROUTINES }
  941. {***************************************************************************}
  942. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  943. {---------------------------------------------------------------------------}
  944. { TvViewMsgHandler -> Platforms WIN/NT - Updated 09Aug99 LdB }
  945. {---------------------------------------------------------------------------}
  946. FUNCTION TvViewMsgHandler (Wnd: hWnd; iMessage, wParam: Sw_Word;
  947. lParam: LongInt): LongInt; {$IFDEF PPC_FPC} STDCALL; {$ENDIF}
  948. VAR Bc: Byte; I: LongInt; W: Word; Event: TEvent; P, Tp: PView;
  949. Q: PScrollBar; Ps: TPaintStruct; Wp: ^TWindowPos;
  950. BEGIN
  951. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  952. PtrRec(P).Seg := GetProp(Wnd, ViewSeg); { Fetch seg property }
  953. PtrRec(P).Ofs := GetProp(Wnd, ViewOfs); { Fetch ofs property }
  954. {$ENDIF}
  955. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  956. LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch view pointer }
  957. {$ENDIF}
  958. If (P <> Nil) Then Begin { Valid view pointer }
  959. TvViewMsgHandler := 0; { Preset return zero }
  960. Event.What := evNothing; { Preset no event }
  961. Case iMessage Of
  962. WM_Close: Begin { CLOSE COMMAND }
  963. If (P^.GetState(sfFocused) = False) Then
  964. P^.FocusFromTop; { Focus if behind }
  965. Event.What := evCommand; { Command event }
  966. Event.Command := cmClose; { Quit command }
  967. Event.InfoPtr := P; { Pointer to view }
  968. End;
  969. WM_LButtonDown: Begin { LEFT MOUSE DOWN }
  970. Event.What := evMouseDown; { Mouse down event }
  971. Event.Double := False; { Not double click }
  972. MouseButtons := MouseButtons OR mbLeftButton;{ Set button mask }
  973. End;
  974. WM_LButtonUp: Begin { LEFT MOUSE UP }
  975. Event.What := evMouseUp; { Mouse up event }
  976. Event.Double := False; { Not double click }
  977. MouseButtons := MouseButtons AND NOT
  978. mbLeftButton; { Clear button mask }
  979. End;
  980. WM_LButtonDBLClk: Begin { LEFT MOUSE DBL CLK }
  981. Event.What := evMouseDown; { Mouse down event }
  982. Event.Double := True; { Double click }
  983. MouseButtons := MouseButtons OR mbLeftButton;{ Set button mask }
  984. End;
  985. WM_RButtonDown: Begin { RIGHT MOUSE DOWN }
  986. Event.What := evMouseDown; { Mouse down event }
  987. Event.Double := False; { Not double click }
  988. MouseButtons := MouseButtons OR
  989. mbRightButton; { Set button mask }
  990. End;
  991. WM_RButtonUp: Begin { RIGHT MOUSE UP }
  992. Event.What := evMouseUp; { Mouse up event }
  993. Event.Double := False; { Not double click }
  994. MouseButtons := MouseButtons AND NOT
  995. mbRightButton; { Clear button mask }
  996. End;
  997. WM_RButtonDBLClk: Begin { RIGHT MOUSE DBL CLK }
  998. Event.What := evMouseDown; { Mouse down event }
  999. Event.Double := True; { Double click }
  1000. MouseButtons := MouseButtons OR
  1001. mbRightButton; { Set button mask }
  1002. End;
  1003. WM_MButtonDown: Begin { MIDDLE MOUSE DOWN }
  1004. Event.What := evMouseDown; { Mouse down event }
  1005. Event.Double := False; { Not double click }
  1006. MouseButtons := MouseButtons OR
  1007. mbMiddleButton; { Set button mask }
  1008. End;
  1009. WM_MButtonUp: Begin { MIDDLE MOUSE UP }
  1010. Event.What := evMouseUp; { Mouse up event }
  1011. Event.Double := False; { Not double click }
  1012. MouseButtons := MouseButtons AND NOT
  1013. mbMiddleButton; { Clear button mask }
  1014. End;
  1015. WM_MButtonDBLClk: Begin { MIDDLE MOUSE DBL CLK }
  1016. Event.What := evMouseDown; { Mouse down event }
  1017. Event.Double := True; { Double click }
  1018. MouseButtons := MouseButtons OR
  1019. mbMiddleButton; { Set button mask }
  1020. End;
  1021. WM_MouseMove: Begin { MOUSE MOVEMENT }
  1022. Event.What := evMouseMove; { Mouse move event }
  1023. Event.Double := False; { Not double click }
  1024. MouseButtons := 0; { Preset clear buttons }
  1025. If (wParam AND mk_LButton <> 0) Then
  1026. MouseButtons := MouseButtons OR
  1027. mbLeftButton; { Left button mask }
  1028. If (wParam AND mk_MButton <> 0) Then
  1029. MouseButtons := MouseButtons OR
  1030. mbLeftButton; { Middle button mask }
  1031. If (wParam AND mk_RButton <> 0) Then
  1032. MouseButtons := MouseButtons OR
  1033. mbRightButton; { Set right button mask }
  1034. End;
  1035. WM_EraseBkGnd: TvViewMsgHandler := 1; { BACKGROUND MESSAGE }
  1036. WM_Paint: If (P^.Dc = 0) Then Begin { PAINT MESSAGE }
  1037. P^.Dc := BeginPaint(Wnd, Ps); { Fetch structure }
  1038. SelectObject(ps.hDC, DefGFVFont); { Select default font }
  1039. P^.DrawMask := P^.DrawMask OR vdNoChild; { Draw this view only }
  1040. P^.ReDrawArea(Ps.rcPaint.Left + P^.RawOrigin.X,
  1041. Ps.rcPaint.Top + P^.RawOrigin.Y,
  1042. Ps.rcPaint.Right + P^.RawOrigin.X-1,
  1043. Ps.rcPaint.Bottom + P^.RawOrigin.Y-1); { Redraw the area }
  1044. P^.DrawMask := P^.DrawMask AND NOT vdNoChild;{ Child draws enabled }
  1045. P^.Dc := 0; { Zero device context }
  1046. EndPaint(Wnd, Ps); { End painting }
  1047. End Else PostMessage(Wnd, iMessage, wParam,
  1048. lParam); { Busy repost message }
  1049. WM_HScroll, WM_VScroll: Begin { SCROLLBAR MESSAGES }
  1050. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1051. PtrRec(Q).Seg := GetProp(HiWord(lParam),
  1052. ViewSeg); { Fetch seg property }
  1053. PtrRec(Q).Ofs := GetProp(HiWord(lParam),
  1054. ViewOfs); { Fetch ofs property }
  1055. W := wParam; { Transfer word }
  1056. {$ENDIF}
  1057. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1058. LongInt(Q) := GetProp(lParam, ViewPtr); { Fetch seg property }
  1059. W := LoWord(wParam); { Low param part }
  1060. {$ENDIF}
  1061. If (Q <> Nil) Then Begin { Valid scrollbar }
  1062. If (Q^.GetState(sfFocused) = False) Then
  1063. Q^.FocusFromTop; { Focus up to us }
  1064. Bc := 0; { Preset do call }
  1065. Case W Of
  1066. SB_TOP: Q^.SetValue(Q^.Min); { Set to minimum }
  1067. SB_BOTTOM: Q^.SetValue(Q^.Max); { Set to maximum }
  1068. SB_ENDSCROLL: Bc := 1; { Fail this call }
  1069. SB_LINEDOWN: Q^.SetValue(Q^.Value +
  1070. Q^.ScrollStep(sbDownArrow)); { One line down }
  1071. SB_LINEUP: Q^.SetValue(Q^.Value +
  1072. Q^.ScrollStep(sbUpArrow)); { One line up }
  1073. SB_PAGEDOWN: Q^.SetValue(Q^.Value +
  1074. Q^.ScrollStep(sbPageDown)); { One page down }
  1075. SB_PAGEUP: Q^.SetValue(Q^.Value +
  1076. Q^.ScrollStep(sbPageUp)); { One page up }
  1077. SB_THUMBPOSITION, SB_THUMBTRACK:
  1078. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1079. Q^.SetValue(LoWord(lParam)); { Set to position }
  1080. {$ENDIF}
  1081. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1082. Q^.SetValue(HiWord(wParam)); { Set to position }
  1083. {$ENDIF}
  1084. Else Bc := 1; { Fail other cases }
  1085. End;
  1086. If (Bc=0) Then NewMessage(Q^.Owner,
  1087. evBroadcast, cmScrollBarClicked, Q^.Id,
  1088. Q^.Value, Q); { Old TV style message }
  1089. End;
  1090. End;
  1091. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1092. WM_CtlColor: If (HiWord(lParam) = CtlColor_Btn){ COLOUR CONTROL }
  1093. OR (HiWord(lParam) = CtlColor_ListBox)
  1094. {$ENDIF}
  1095. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1096. WM_CtlColorListBox, WM_CtlColorBtn: { COLOUR LISTBOX/BUTTON }
  1097. If (lParam <> 0) { Valid handle }
  1098. {$ENDIF}
  1099. Then Begin
  1100. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1101. PtrRec(P).Seg := GetProp(LoWord(lParam),
  1102. ViewSeg); { Get view segment }
  1103. PtrRec(P).Ofs := GetProp(LoWord(lParam),
  1104. ViewOfs); { Get view segment }
  1105. {$ENDIF}
  1106. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1107. LongInt(P) := GetProp(LoWord(lParam),
  1108. ViewPtr); { Get view pointer }
  1109. {$ENDIF}
  1110. If (P <> Nil) Then Begin { Valid view }
  1111. Bc := P^.GetColor(1) AND $F0 SHR 4; { Background colour }
  1112. SetTextColor(wParam, ColRef[P^.GetColor(1)
  1113. AND $0F]); { Set text colour }
  1114. SetBkColor(wParam, ColRef[Bc]); { Set background colour }
  1115. TvViewMsgHandler := ColBrush[Bc]; { Return colour brush }
  1116. End Else TvViewMsgHandler := DefWindowProc(
  1117. Wnd, iMessage, wParam, lParam); { Call default handler }
  1118. End Else TvViewMsgHandler := DefWindowProc(
  1119. Wnd, iMessage, wParam, lParam); { Call default handler }
  1120. WM_SysCommand: Begin { SYSTEM COMMAND MESSAGE }
  1121. If (P^.GetState(sfFocused) = False) Then
  1122. P^.FocusFromTop; { Focus if behind }
  1123. TvViewMsgHandler := DefWindowProc(
  1124. Wnd, iMessage, wParam, lParam);
  1125. If IsIconic(Wnd) Then BringWindowToTop(Wnd);
  1126. End;
  1127. WM_Command: Begin { COMMAND MESSAGE }
  1128. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1129. W := HiWord(lParam); { Message of lParam }
  1130. {$ENDIF}
  1131. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1132. W := HiWord(wParam); { Handle high of wParam }
  1133. {$ENDIF}
  1134. Case W Of
  1135. cbn_SelChange: Begin { COMBO/LIST SELECTION }
  1136. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1137. PtrRec(Tp).Seg := GetProp(LoWord(lParam),
  1138. ViewSeg); { Fetch combo seg }
  1139. PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
  1140. ViewOfs); { Fetch combo ofs }
  1141. {$ENDIF}
  1142. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1143. LongInt(Tp) := GetProp(LoWord(lParam),
  1144. ViewPtr); { Fetch combo ptr }
  1145. {$ENDIF}
  1146. If (Tp <> Nil) Then Begin { View is valid }
  1147. I := SendMessage(LoWord(lParam),
  1148. Tp^.GetNotifyCmd, 0, 0); { Get current state }
  1149. Event.What := evCommand; { Command event }
  1150. Event.Command := cmNotify; { Notify command }
  1151. Event.data := I; { Load data value }
  1152. Event.InfoPtr := Tp; { Pointer to view }
  1153. End;
  1154. End;
  1155. cbn_SetFocus: Begin { DROP BOX FOCUSED }
  1156. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1157. PtrRec(Tp).Seg := GetProp(LoWord(lParam),
  1158. ViewSeg); { Fetch combo seg }
  1159. PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
  1160. ViewOfs); { Fetch combo ofs }
  1161. {$ENDIF}
  1162. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1163. LongInt(Tp) := GetProp(LoWord(lParam),
  1164. ViewPtr); { Fetch combo ptr }
  1165. {$ENDIF}
  1166. If (Tp <> Nil) AND { Combo box valid }
  1167. (Tp^.GetState(sfFocused) = False) Then { We have not focus }
  1168. Tp^.FocusFromTop; { Focus up to us }
  1169. End;
  1170. lbn_SetFocus: Begin { LIST BOX FOCUSED }
  1171. {$IFDEF BIT_16} { 16 BIT WINDOWS CODE }
  1172. PtrRec(Tp).Seg := GetProp(LoWord(lParam),
  1173. ViewSeg); { Fetch listbox seg }
  1174. PtrRec(Tp).Ofs := GetProp(LoWord(lParam),
  1175. ViewOfs); { Fetch listbox ofs }
  1176. {$ENDIF}
  1177. {$IFDEF BIT_32} { 32 BIT WINDOWS CODE }
  1178. LongInt(Tp) := GetProp(LoWord(lParam),
  1179. ViewPtr); { Fetch listbox ptr }
  1180. {$ENDIF}
  1181. If (Tp <> Nil) Then Begin { Listbox is valid }
  1182. If (Tp^.GetState(sfFocused) = False) { We have not focus }
  1183. Then Tp^.FocusFromTop; { Focus up to us }
  1184. End;
  1185. End;
  1186. Else TvViewMsgHandler := DefWindowProc(
  1187. Wnd, iMessage, wParam, lParam); { Call default handler }
  1188. End;
  1189. End;
  1190. WM_Activate, WM_ChildActivate: Begin
  1191. If (P^.Options AND ofTopSelect <> 0) { Top selectable view }
  1192. AND (P^.Options AND ofSelectable <> 0) { View is selectable }
  1193. Then P^.FocusFromTop; { Focus us from top }
  1194. End;
  1195. WM_WindowPosChanged: Begin { WINDOW HAS MOVED }
  1196. If (NOT ISIconic(Wnd)) AND (lParam <> 0) { Window not iconic }
  1197. Then Begin
  1198. Wp := Pointer(lParam); { TWindowpos structure }
  1199. If (Wp^.Flags AND swp_NoMove = 0) { No move flag is clear }
  1200. Then Begin
  1201. If (P^.Owner <> Nil) Then
  1202. P^.DisplaceBy(Wp^.X + P^.Owner^.RawOrigin.X -
  1203. P^.RawOrigin.X + P^.Owner^.FrameSize,
  1204. Wp^.Y + P^.Owner^.RawOrigin.Y -
  1205. P^.RawOrigin.Y + P^.Owner^.CaptSize) { Displace the window }
  1206. Else P^.DisplaceBy(Wp^.X + P^.RawOrigin.X,
  1207. Wp^.Y - P^.RawOrigin.Y); { Displace the window }
  1208. End;
  1209. If (Wp^.Flags AND swp_NoSize = 0) { No resize flag clear }
  1210. Then Begin
  1211. P^.RawSize.X := Wp^.Cx; { Size the window x }
  1212. P^.RawSize.Y := Wp^.Cy; { Size the window y }
  1213. End;
  1214. End;
  1215. TvViewMsgHandler := DefWindowProc(Wnd,
  1216. iMessage, wParam, lParam); { Default handler }
  1217. End;
  1218. Else TvViewMsgHandler := DefWindowProc(Wnd,
  1219. iMessage, wParam, lParam); { Call Default handler }
  1220. End; { End of case }
  1221. If (Event.What <> evNothing) Then Begin { Check any GFV event }
  1222. If (Event.What AND evMouse <> 0) Then Begin { Mouse event }
  1223. If (P <> Nil) Then Begin { Valid view pointer }
  1224. Event.Where.X := LoWord(lParam) +
  1225. P^.RawOrigin.X + P^.FrameSize; { X mouse co-ordinate }
  1226. Event.Where.Y := HiWord(lParam) +
  1227. P^.RawOrigin.Y + P^.CaptSize; { Y mouse co-ordinate }
  1228. MouseWhere := Event.Where; { Update mouse where }
  1229. Event.Buttons := MouseButtons; { Return mouse buttons }
  1230. End Else Exit; { View is not valid }
  1231. End;
  1232. PutEventInQueue(Event); { Put event in queue }
  1233. End;
  1234. End Else TvViewMsgHandler := DefWindowProc(Wnd,
  1235. iMessage, wParam, lParam); { Call Default handler }
  1236. END;
  1237. {$ENDIF}
  1238. {$IFDEF OS_OS2} { OS2 CODE }
  1239. {---------------------------------------------------------------------------}
  1240. { TvViewMsgHandler -> Platforms OS2 - Updated 09Aug99 LdB }
  1241. {---------------------------------------------------------------------------}
  1242. FUNCTION TvViewMsgHandler(Wnd: HWnd; Msg: ULong; Mp1, Mp2: MParam): MResult;
  1243. VAR Bc: Byte; R: RectL; Event: TEvent; P: PView; Pt: PointL; PS: hPs; Sp: Swp;
  1244. Q: PScrollBar; Sh: HWnd;
  1245. BEGIN
  1246. P := Nil; { Clear the pointer }
  1247. WinQueryPresParam(Wnd, PP_User, 0, Nil,
  1248. SizeOf(Pointer), @P, 0); { Fetch view pointer }
  1249. If (P <> Nil) Then Begin { PView is valid }
  1250. TvViewMSgHandler := 0; { Preset handled }
  1251. Event.What := evNothing; { Preset no event }
  1252. Case Msg Of
  1253. WM_Close: Begin { CLOSE COMMAND }
  1254. If (P^.GetState(sfFocused) = False) Then
  1255. P^.FocusFromTop; { Focus if behind }
  1256. Event.What := evCommand; { Command event }
  1257. Event.Command := cmClose; { Quit command }
  1258. Event.InfoPtr := P; { Pointer to view }
  1259. End;
  1260. WM_EraseBackGround: TvViewMsgHandler := { BACKGROUND ERASE }
  1261. LongInt(False); { Return false }
  1262. WM_Paint: If (P^.Ps = 0) Then Begin { PAINT MESSAGE }
  1263. P^.Ps := WinBeginPaint(Wnd, 0, @R); { Fetch structure }
  1264. P^.DrawMask := P^.DrawMask OR vdNoChild; { Draw this view only }
  1265. P^.ReDrawArea(R.xLeft + P^.RawOrigin.X,
  1266. R.yBottom + P^.RawOrigin.Y,
  1267. R.xRight + P^.RawOrigin.X,
  1268. R.yTop + P^.RawOrigin.Y); { Redraw the area }
  1269. P^.DrawMask := P^.DrawMask AND NOT vdNoChild;{ Child draws enabled }
  1270. P^.Ps := 0; { Zero device context }
  1271. WinEndPaint(Ps); { End painting }
  1272. End Else WinPostMsg(Wnd, Msg, Mp1, Mp2); { Busy repost message }
  1273. WM_Button1Down: Begin { LEFT MOUSE DOWN }
  1274. Event.What := evMouseDown; { Mouse down event }
  1275. Event.Double := False; { Not double click }
  1276. MouseButtons := MouseButtons OR
  1277. mbLeftButton; { Set button mask }
  1278. End;
  1279. WM_Button1Up: Begin { LEFT MOUSE UP }
  1280. Event.What := evMouseUp; { Mouse up event }
  1281. Event.Double := False; { Not double click }
  1282. MouseButtons := MouseButtons AND NOT
  1283. mbLeftButton; { Clear button mask }
  1284. End;
  1285. WM_Button1DBLClk: Begin { LEFT MOUSE DBL CLK }
  1286. Event.What := evMouseDown; { Mouse down event }
  1287. Event.Double := True; { Double click }
  1288. MouseButtons := MouseButtons OR
  1289. mbLeftButton; { Set button mask }
  1290. End;
  1291. WM_Button2Down: Begin { RIGHT MOUSE DOWN }
  1292. Event.What := evMouseDown; { Mouse down event }
  1293. Event.Double := False; { Not double click }
  1294. MouseButtons := MouseButtons OR
  1295. mbRightButton; { Set button mask }
  1296. End;
  1297. WM_Button2Up: Begin { RIGHT MOUSE UP }
  1298. Event.What := evMouseUp; { Mouse up event }
  1299. Event.Double := False; { Not double click }
  1300. MouseButtons := MouseButtons AND NOT
  1301. mbRightButton; { Clear button mask }
  1302. End;
  1303. WM_Button2DBLClk: Begin { RIGHT MOUSE DBL CLK }
  1304. Event.What := evMouseDown; { Mouse down event }
  1305. Event.Double := True; { Double click }
  1306. MouseButtons := MouseButtons OR
  1307. mbLeftButton; { Set button mask }
  1308. End;
  1309. WM_Button3Down: Begin { MIDDLE MOUSE DOWN }
  1310. Event.What := evMouseDown; { Mouse down event }
  1311. Event.Double := False; { Not double click }
  1312. MouseButtons := MouseButtons OR
  1313. mbMiddleButton; { Set button mask }
  1314. End;
  1315. WM_Button3Up: Begin { MIDDLE MOUSE UP }
  1316. Event.What := evMouseUp; { Mouse up event }
  1317. Event.Double := False; { Not double click }
  1318. MouseButtons := MouseButtons AND NOT
  1319. mbMiddleButton; { Clear button mask }
  1320. End;
  1321. WM_Button3DBLClk: Begin { MIDDLE MOUSE DBL CLK }
  1322. Event.What := evMouseDown; { Mouse down event }
  1323. Event.Double := True; { Double click }
  1324. MouseButtons := MouseButtons OR
  1325. mbMiddleButton; { Set button mask }
  1326. End;
  1327. WM_MouseMove: Begin { MOUSE MOVEMENT }
  1328. Event.What := evMouseMove; { Mouse move event }
  1329. Event.Double := False; { Not double click }
  1330. If (WinQueryPointer(HWND_Desktop) <>
  1331. DefPointer) Then { Check mouse ptr }
  1332. WinSetPointer(HWND_DeskTop, DefPointer); { Set mouse ptr }
  1333. End;
  1334. WM_HScroll, WM_VScroll: Begin { SCROLLBAR MESSAGES }
  1335. Q := Nil; { Clear the pointer }
  1336. Sh := WinQueryFocus(HWnd_DeskTop); { Scrollbar has focus }
  1337. If (Sh <> 0) Then WinQueryPresParam(Sh,
  1338. PP_User, 0, Nil, SizeOf(Pointer), @Q, 0); { Fetch scrollbar ptr }
  1339. If (Q <> Nil) AND (Q^.GOptions AND
  1340. goNativeClass <> 0) Then Begin { Valid scrollbar }
  1341. If (Q^.GetState(sfFocused) = False) Then
  1342. Q^.FocusFromTop; { Focus up to us }
  1343. Bc := 0; { Preset do call }
  1344. Case Short2FromMP(Mp2) Of { Scrollbar message }
  1345. SB_ENDSCROLL:;
  1346. SB_LINEDOWN: Q^.SetValue(Q^.Value +
  1347. Q^.ScrollStep(sbDownArrow)); { One line down }
  1348. SB_LINEUP: Q^.SetValue(Q^.Value +
  1349. Q^.ScrollStep(sbUpArrow)); { One line up }
  1350. SB_PAGEDOWN: Q^.SetValue(Q^.Value +
  1351. Q^.ScrollStep(sbPageDown)); { One page down }
  1352. SB_PAGEUP: Q^.SetValue(Q^.Value +
  1353. Q^.ScrollStep(sbPageUp)); { One page up }
  1354. SB_SLIDERPOSITION, SB_SLIDERTRACK:
  1355. Q^.SetValue(Short1FromMP(Mp2)); { Set to position }
  1356. Else Bc := 1; { Fail other cases }
  1357. End;
  1358. If (Bc=0) Then NewMessage(Q^.Owner,
  1359. evBroadcast, cmScrollBarClicked, Q^.Id,
  1360. Q^.Value, Q); { Old TV style message }
  1361. End;
  1362. End;
  1363. WM_QueryTrackInfo: Begin { WINDOW HAS MOVED }
  1364. (*If (NOT ISIconic(Wnd)) AND (lParam <> 0) { Window not iconic }
  1365. Then Begin*)
  1366. (*Sp := PSwp(Mp1)^; { New SWP data }
  1367. If (Sp.Fl AND swp_Size <> 0) Then Begin { Size change request }
  1368. P^.RawSize.X := Sp.Cx-1; { Size the window x }
  1369. P^.RawSize.Y := Sp.Cy-1; { Size the window y }
  1370. End;*)
  1371. (*P^.DisplaceBy(Sp1.X - Sp2.X,
  1372. -(Sp1.Y - Sp2.Y));*)
  1373. TvViewMSgHandler := 0;
  1374. End;
  1375. Else TvViewMSgHandler := WinDefWindowProc(
  1376. Wnd, Msg, Mp1, Mp2); { Call default handler }
  1377. End;
  1378. If (Event.What <> evNothing) Then Begin { Check any FV event }
  1379. If (Event.What AND evMouse <> 0) Then Begin { Mouse event }
  1380. WinQueryWindowPos(Wnd, Sp); { Query client area }
  1381. Event.Where.X := Short1FromMP(Mp1)-1
  1382. + P^.RawOrigin.X; { X mouse co-ordinate }
  1383. Event.Where.Y := Sp.Cy -
  1384. Short2FromMP(Mp1)-1 + P^.RawOrigin.Y; { Y mouse co-ordinate }
  1385. Event.Buttons := MouseButtons; { Return buttons }
  1386. MouseWhere := Event.Where; { Update mouse where }
  1387. End;
  1388. PutEventInQueue(Event); { Put event in queue }
  1389. End;
  1390. End Else TvViewMSgHandler := WinDefWindowProc(Wnd,
  1391. Msg, Mp1, Mp2); { Call default handler }
  1392. END;
  1393. {$ENDIF}
  1394. {***************************************************************************}
  1395. { OBJECT METHODS }
  1396. {***************************************************************************}
  1397. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1398. { TView OBJECT METHODS }
  1399. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1400. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  1401. {---------------------------------------------------------------------------}
  1402. { TView WINDOW CLASS NAME CONSTANT }
  1403. {---------------------------------------------------------------------------}
  1404. CONST TvViewClassName = 'TVIEW'; { TView window class }
  1405. {$ENDIF}
  1406. {--TView--------------------------------------------------------------------}
  1407. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20Jun96 LdB }
  1408. {---------------------------------------------------------------------------}
  1409. CONSTRUCTOR TView.Init (Var Bounds: TRect);
  1410. BEGIN
  1411. Inherited Init; { Call ancestor }
  1412. DragMode := dmLimitLoY; { Default drag mode }
  1413. HelpCtx := hcNoContext; { Clear help context }
  1414. State := sfVisible; { Default state }
  1415. EventMask := evMouseDown + evKeyDown + evCommand; { Default event masks }
  1416. GOptions := goTabSelect; { Set new options }
  1417. SetBounds(Bounds); { Set view bounds }
  1418. END;
  1419. {--TView--------------------------------------------------------------------}
  1420. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  1421. {---------------------------------------------------------------------------}
  1422. { This load method will read old original TV data from a stream but the }
  1423. { new options and tabmasks are not set so some NEW functionality is not }
  1424. { supported but it should work as per original TV code. }
  1425. {---------------------------------------------------------------------------}
  1426. CONSTRUCTOR TView.Load (Var S: TStream);
  1427. BEGIN
  1428. Inherited Init; { Call ancestor }
  1429. S.Read(Origin.X, 2); { Read origin x value }
  1430. S.Read(Origin.Y, 2); { Read origin y value }
  1431. S.Read(Size.X, 2); { Read view x size }
  1432. S.Read(Size.Y, 2); { Read view y size }
  1433. S.Read(Cursor.X, 2); { Read cursor x size }
  1434. S.Read(Cursor.Y, 2); { Read cursor y size }
  1435. S.Read(GrowMode, 1); { Read growmode flags }
  1436. S.Read(DragMode, 1); { Read dragmode flags }
  1437. S.Read(HelpCtx, 2); { Read help context }
  1438. S.Read(State, 2); { Read state masks }
  1439. S.Read(Options, 2); { Read options masks }
  1440. S.Read(Eventmask, 2); { Read event masks }
  1441. If (Options AND ofGFVModeView <> 0) Then Begin { STREAM HAS GFV TVIEW }
  1442. S.Read(GOptions, 2); { Read new option masks }
  1443. S.Read(TabMask, 1); { Read new tab masks }
  1444. S.Read(RawOrigin.X, 2); { Read raw x origin point }
  1445. S.Read(RawOrigin.Y, 2); { Read raw y origin point }
  1446. S.Read(RawSize.X, 2); { Read raw x size }
  1447. S.Read(RawSize.Y, 2); { Read raw y size }
  1448. S.Read(ColourOfs, 2); { Read palette offset }
  1449. End Else Begin { STREAM HAS OLD TView }
  1450. RawOrigin.X := Origin.X * FontWidth; { Set x origin pt }
  1451. RawOrigin.Y := Origin.Y * FontHeight; { Set y origin pt }
  1452. RawSize.X := (Size.X * FontWidth) - 1; { Calc raw x size }
  1453. RawSize.Y := (Size.Y * FontHeight) - 1; { Calc raw y size }
  1454. End;
  1455. END;
  1456. {--TView--------------------------------------------------------------------}
  1457. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Nov99 LdB }
  1458. {---------------------------------------------------------------------------}
  1459. DESTRUCTOR TView.Done;
  1460. VAR P: PComplexArea; {$IFNDEF OS_DOS} S: String; {$ENDIF}
  1461. BEGIN
  1462. Hide; { Hide the view }
  1463. If (Owner <> Nil) Then Owner^.Delete(@Self); { Delete from owner }
  1464. While (HoldLimit <> Nil) Do Begin { Free limit memory }
  1465. P := HoldLimit^.NextArea; { Hold next pointer }
  1466. FreeMem(HoldLimit, SizeOf(TComplexArea)); { Release memory }
  1467. HoldLimit := P; { Shuffle to next }
  1468. End;
  1469. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  1470. If (HWindow <> 0) Then Begin { Handle valid }
  1471. S := GetClassName + #0; { Make asciiz }
  1472. {$IFDEF OS_WINDOWS} { WIN/NT CODE}
  1473. {$IFDEF BIT_16} { 16 BIT CODE }
  1474. RemoveProp(HWindow, ViewSeg); { Remove seg property }
  1475. RemoveProp(HWindow, ViewOfs); { Remove offs property }
  1476. {$ENDIF}
  1477. {$IFDEF BIT_32} { 32 BIT CODE }
  1478. RemoveProp(HWindow, ViewPtr); { Remove view property }
  1479. {$ENDIF}
  1480. DestroyWindow(HWindow); { Destroy window }
  1481. If (GOptions AND goNativeClass = 0) Then { Not native class check }
  1482. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  1483. UnRegisterClass(CString(@S[1]), 0); { Unregister class }
  1484. {$ELSE} { OTHER COMPILERS }
  1485. UnRegisterClass(@S[1], HInstance); { Unregister class }
  1486. {$ENDIF}
  1487. {$ENDIF}
  1488. {$IFDEF OS_OS2} { OS2 CODE }
  1489. WinRemovePresParam(HWindow, PP_User); { Remove self ptr }
  1490. WinDestroyWindow(HWindow); { Destroy window }
  1491. If (GOptions AND goNativeClass = 0) Then { Not native class check }
  1492. WinDeregisterObjectClass(@S[1]); { Unregister class }
  1493. {$ENDIF}
  1494. End;
  1495. {$ENDIF}
  1496. END;
  1497. {--TView--------------------------------------------------------------------}
  1498. { Prev -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1499. {---------------------------------------------------------------------------}
  1500. FUNCTION TView.Prev: PView;
  1501. VAR P: PView;
  1502. BEGIN
  1503. P := @Self; { Start with self }
  1504. While (P^.Next <> Nil) AND (P^.Next <> @Self)
  1505. Do P := P^.Next; { Locate next view }
  1506. Prev := P; { Return result }
  1507. END;
  1508. {--TView--------------------------------------------------------------------}
  1509. { Execute -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1510. {---------------------------------------------------------------------------}
  1511. FUNCTION TView.Execute: Word;
  1512. BEGIN
  1513. Execute := cmCancel; { Return cancel }
  1514. END;
  1515. {--TView--------------------------------------------------------------------}
  1516. { Focus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  1517. {---------------------------------------------------------------------------}
  1518. FUNCTION TView.Focus: Boolean;
  1519. VAR Res: Boolean;
  1520. BEGIN
  1521. Res := True; { Preset result }
  1522. If (State AND (sfSelected + sfModal)=0) Then Begin { Not modal/selected }
  1523. If (Owner <> Nil) Then Begin { View has an owner }
  1524. Res := Owner^.Focus; { Return focus state }
  1525. If Res Then { Owner has focus }
  1526. If ((Owner^.Current = Nil) OR { No current view }
  1527. (Owner^.Current^.Options AND ofValidate = 0) { Non validating view }
  1528. OR (Owner^.Current^.Valid(cmReleasedFocus))) { Okay to drop focus }
  1529. Then Select Else Res := False; { Then select us }
  1530. End;
  1531. End;
  1532. Focus := Res; { Return focus result }
  1533. END;
  1534. {--TView--------------------------------------------------------------------}
  1535. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1536. {---------------------------------------------------------------------------}
  1537. FUNCTION TView.DataSize: Word;
  1538. BEGIN
  1539. DataSize := 0; { Transfer size }
  1540. END;
  1541. {--TView--------------------------------------------------------------------}
  1542. { TopView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1543. {---------------------------------------------------------------------------}
  1544. FUNCTION TView.TopView: PView;
  1545. VAR P: PView;
  1546. BEGIN
  1547. If (TheTopView = Nil) Then Begin { Check topmost view }
  1548. P := @Self; { Start with us }
  1549. While (P <> Nil) AND (P^.State AND sfModal = 0) { Check if modal }
  1550. Do P := P^.Owner; { Search each owner }
  1551. TopView := P; { Return result }
  1552. End Else TopView := TheTopView; { Return topview }
  1553. END;
  1554. {--TView--------------------------------------------------------------------}
  1555. { PrevView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1556. {---------------------------------------------------------------------------}
  1557. FUNCTION TView.PrevView: PView;
  1558. BEGIN
  1559. If (@Self = Owner^.First) Then PrevView := Nil { We are first view }
  1560. Else PrevView := Prev; { Return our prior }
  1561. END;
  1562. {--TView--------------------------------------------------------------------}
  1563. { NextView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1564. {---------------------------------------------------------------------------}
  1565. FUNCTION TView.NextView: PView;
  1566. BEGIN
  1567. If (@Self = Owner^.Last) Then NextView := Nil { This is last view }
  1568. Else NextView := Next; { Return our next }
  1569. END;
  1570. {--TView--------------------------------------------------------------------}
  1571. { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1572. {---------------------------------------------------------------------------}
  1573. FUNCTION TView.GetHelpCtx: Word;
  1574. BEGIN
  1575. If (State AND sfDragging <> 0) Then { Dragging state check }
  1576. GetHelpCtx := hcDragging Else { Return dragging }
  1577. GetHelpCtx := HelpCtx; { Return help context }
  1578. END;
  1579. {--TView--------------------------------------------------------------------}
  1580. { EventAvail -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1581. {---------------------------------------------------------------------------}
  1582. FUNCTION TView.EventAvail: Boolean;
  1583. VAR Event: TEvent;
  1584. BEGIN
  1585. GetEvent(Event); { Get next event }
  1586. If (Event.What <> evNothing) Then PutEvent(Event); { Put it back }
  1587. EventAvail := (Event.What <> evNothing); { Return result }
  1588. END;
  1589. {--TView--------------------------------------------------------------------}
  1590. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1591. {---------------------------------------------------------------------------}
  1592. FUNCTION TView.GetPalette: PPalette;
  1593. BEGIN
  1594. GetPalette := Nil; { Return nil ptr }
  1595. END;
  1596. {--TView--------------------------------------------------------------------}
  1597. { GetColor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB }
  1598. {---------------------------------------------------------------------------}
  1599. FUNCTION TView.GetColor (Color: Word): Word;
  1600. VAR Col: Byte; W: Word; P: PPalette; Q: PView;
  1601. BEGIN
  1602. W := 0; { Clear colour word }
  1603. If (Hi(Color) > 0) Then Begin { High colour req }
  1604. Col := Hi(Color) + ColourOfs; { Initial offset }
  1605. Q := @Self; { Pointer to self }
  1606. Repeat
  1607. P := Q^.GetPalette; { Get our palette }
  1608. If (P <> Nil) Then Begin { Palette is valid }
  1609. If (Col <= Length(P^)) Then
  1610. Col := Ord(P^[Col]) Else { Return colour }
  1611. Col := ErrorAttr; { Error attribute }
  1612. End;
  1613. Q := Q^.Owner; { Move up to owner }
  1614. Until (Q = Nil); { Until no owner }
  1615. W := Col SHL 8; { Translate colour }
  1616. End;
  1617. If (Lo(Color) > 0) Then Begin
  1618. Col := Lo(Color) + ColourOfs; { Initial offset }
  1619. Q := @Self; { Pointer to self }
  1620. Repeat
  1621. P := Q^.GetPalette; { Get our palette }
  1622. If (P <> Nil) Then Begin { Palette is valid }
  1623. If (Col <= Length(P^)) Then
  1624. Col := Ord(P^[Col]) Else { Return colour }
  1625. Col := ErrorAttr; { Error attribute }
  1626. End;
  1627. Q := Q^.Owner; { Move up to owner }
  1628. Until (Q = Nil); { Until no owner }
  1629. End Else Col := ErrorAttr; { No colour found }
  1630. GetColor := W OR Col; { Return color }
  1631. END;
  1632. {--TView--------------------------------------------------------------------}
  1633. { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1634. {---------------------------------------------------------------------------}
  1635. FUNCTION TView.Valid (Command: Word): Boolean;
  1636. BEGIN
  1637. Valid := True; { Simply return true }
  1638. END;
  1639. {--TView--------------------------------------------------------------------}
  1640. { GetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1641. {---------------------------------------------------------------------------}
  1642. FUNCTION TView.GetState (AState: Word): Boolean;
  1643. BEGIN
  1644. GetState := State AND AState = AState; { Check states equal }
  1645. END;
  1646. {--TView--------------------------------------------------------------------}
  1647. { TextWidth -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Nov99 LdB }
  1648. {---------------------------------------------------------------------------}
  1649. FUNCTION TView.TextWidth (Txt: String): Integer;
  1650. VAR I: Integer; S: String;
  1651. {$IFNDEF OS_DOS} P: Pointer; Wnd: HWnd; {$ENDIF}
  1652. {$IFDEF OS_WINDOWS} ODc: HDc; M: TSize; {$ENDIF}
  1653. {$IFDEF OS_OS2} OPs: HPs; Pt: Array [0..3] Of PointL; {$ENDIF}
  1654. BEGIN
  1655. S := Txt; { Transfer text }
  1656. Repeat
  1657. I := Pos('~', S); { Check for tilde }
  1658. If (I <> 0) Then System.Delete(S, I, 1); { Remove the tilde }
  1659. Until (I = 0); { Remove all tildes }
  1660. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1661. TextWidth := Length(S) * SysFontWidth; { Calc text length }
  1662. {$ENDIF}
  1663. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1664. ODc := Dc; { Hold device context }
  1665. If (Dc = 0) Then Begin { No context set }
  1666. If (HWindow = 0) OR (State AND sfVisible = 0) { Check window valid }
  1667. OR (State AND sfExposed = 0)
  1668. Then Wnd := AppWindow Else Wnd := HWindow; { Select window or app }
  1669. Dc := GetDC(Wnd); { Get device context }
  1670. End;
  1671. SelectObject(Dc, DefGFVFont); { Select the font }
  1672. P := @S[1]; { Pointer to text }
  1673. {$IFDEF BIT_32} { WINDOWS 32 BIT CODE }
  1674. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  1675. If (GetTextExtentPoint(Dc, CString(P),
  1676. Length(S), M)=False) Then M.Cx := 0; { Get text extents }
  1677. {$ELSE} { OTHER COMPILERS }
  1678. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  1679. If (GetTextExtentPoint(Dc, P, Length(S),
  1680. @M)=False) Then M.Cx := 0; { Get text extents }
  1681. {$ELSE} { ALL OTHER COMPILERS }
  1682. If (GetTextExtentPoint(Dc, P, Length(S),
  1683. M)=False) Then M.Cx := 0; { Get text extents }
  1684. {$ENDIF}
  1685. {$ENDIF}
  1686. {$ELSE} { WINDOWS 16 BIT CODE }
  1687. {$IFDEF PPC_DELPHI} { DELPHI1 COMPILER }
  1688. If (GetTextExtentPoint(Dc, @S[1], Length(S),
  1689. M)=False)Then M.Cx := 0; { Get text extents }
  1690. {$ELSE} { OTHER COMPILERS }
  1691. If (GetTextExtentPoint(Dc, @S[1], Length(S),
  1692. M.Cx)=False)Then M.Cx := 0; { Get text extents }
  1693. {$ENDIF}
  1694. {$ENDIF}
  1695. TextWidth := M.Cx; { Return text width }
  1696. If (ODc = 0) Then ReleaseDC(Wnd, Dc); { Release context }
  1697. Dc := ODc; { Original context set }
  1698. {$ENDIF}
  1699. {$IFDEF OS_OS2}
  1700. OPs := Ps; { Hold pres space }
  1701. If (Ps = 0) Then Begin
  1702. If (HWindow = 0) OR (State AND sfVisible = 0) { Check window valid }
  1703. OR (State AND sfExposed = 0)
  1704. Then Wnd := AppWindow Else Wnd := Client; { Select window or app }
  1705. Ps := WinGetPS(Wnd); { Get pres space }
  1706. End;
  1707. GPISetCharSet(PS, DefGFVFont); { Set the font style }
  1708. P := @S[1]; { Pointer to text }
  1709. GpiQueryTextBox(Ps, Length(S), P, 3, Pt[0]); { Get text extents }
  1710. TextWidth := Pt[2].X; { Return text width }
  1711. If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
  1712. Ps := OPs; { Original pres space }
  1713. {$ENDIF}
  1714. END;
  1715. {--TView--------------------------------------------------------------------}
  1716. { MouseInView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1717. {---------------------------------------------------------------------------}
  1718. FUNCTION TView.MouseInView (Point: TPoint): Boolean;
  1719. BEGIN
  1720. MouseInView := False; { Preset false }
  1721. If (Point.X < RawOrigin.X) Then Exit; { Point to left }
  1722. If (Point.X > (RawOrigin.X+RawSize.X)) Then Exit; { Point to right }
  1723. If (Point.Y < RawOrigin.Y) Then Exit; { Point is above }
  1724. If (Point.Y > (RawOrigin.Y+RawSize.Y)) Then Exit; { Point is below }
  1725. MouseInView := True; { Return true }
  1726. END;
  1727. {--TView--------------------------------------------------------------------}
  1728. { CommandEnabled -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1729. {---------------------------------------------------------------------------}
  1730. FUNCTION TView.CommandEnabled(Command: Word): Boolean;
  1731. BEGIN
  1732. CommandEnabled := (Command > 255) OR
  1733. (Command IN CurCommandSet); { Check command }
  1734. END;
  1735. {--TView--------------------------------------------------------------------}
  1736. { OverLapsArea -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1737. {---------------------------------------------------------------------------}
  1738. FUNCTION TView.OverlapsArea (X1, Y1, X2, Y2: Integer): Boolean;
  1739. BEGIN
  1740. OverLapsArea := False; { Preset false }
  1741. If (RawOrigin.X > X2) Then Exit; { Area to the left }
  1742. If ((RawOrigin.X + RawSize.X) < X1) Then Exit; { Area to the right }
  1743. If (RawOrigin.Y > Y2) Then Exit; { Area is above }
  1744. If ((RawOrigin.Y + RawSize.Y) < Y1) Then Exit; { Area is below }
  1745. OverLapsArea := True; { Return true }
  1746. END;
  1747. {--TView--------------------------------------------------------------------}
  1748. { MouseEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1749. {---------------------------------------------------------------------------}
  1750. FUNCTION TView.MouseEvent (Var Event: TEvent; Mask: Word): Boolean;
  1751. BEGIN
  1752. Repeat
  1753. GetEvent(Event); { Get next event }
  1754. Until (Event.What AND (Mask OR evMouseUp) <> 0); { Wait till valid }
  1755. MouseEvent := Event.What <> evMouseUp; { Return result }
  1756. END;
  1757. {--TView--------------------------------------------------------------------}
  1758. { Hide -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1759. {---------------------------------------------------------------------------}
  1760. PROCEDURE TView.Hide;
  1761. BEGIN
  1762. If (State AND sfVisible <> 0) Then { View is visible }
  1763. SetState(sfVisible, False); { Hide the view }
  1764. END;
  1765. {--TView--------------------------------------------------------------------}
  1766. { Show -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  1767. {---------------------------------------------------------------------------}
  1768. PROCEDURE TView.Show;
  1769. BEGIN
  1770. If (State AND sfVisible = 0) Then { View not visible }
  1771. SetState(sfVisible, True); { Show the view }
  1772. END;
  1773. {--TView--------------------------------------------------------------------}
  1774. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1775. {---------------------------------------------------------------------------}
  1776. PROCEDURE TView.Draw;
  1777. BEGIN { Abstract method }
  1778. END;
  1779. {--TView--------------------------------------------------------------------}
  1780. { Select -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  1781. {---------------------------------------------------------------------------}
  1782. PROCEDURE TView.Select;
  1783. BEGIN
  1784. If (Options AND ofSelectable <> 0) Then { View is selectable }
  1785. If (Options AND ofTopSelect <> 0) Then MakeFirst { Top selectable }
  1786. Else If (Owner <> Nil) Then { Valid owner }
  1787. Owner^.SetCurrent(@Self, NormalSelect); { Make owners current }
  1788. END;
  1789. {--TView--------------------------------------------------------------------}
  1790. { Awaken -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1791. {---------------------------------------------------------------------------}
  1792. PROCEDURE TView.Awaken;
  1793. BEGIN { Abstract method }
  1794. END;
  1795. {--TView--------------------------------------------------------------------}
  1796. { DrawView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  1797. {---------------------------------------------------------------------------}
  1798. PROCEDURE TView.DrawView;
  1799. VAR ViewPort: ViewPortType; { Common variables }
  1800. {$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF} { WIN/NT variables }
  1801. {$IFDEF OS_OS2} OPs: HPs; {$ENDIF} { OS2 variables }
  1802. BEGIN
  1803. If (State AND sfVisible <> 0) AND { View is visible }
  1804. (State AND sfExposed <> 0) AND { View is exposed }
  1805. (State AND sfIconised = 0) Then Begin { View not iconised }
  1806. SetViewLimits; { Set view limits }
  1807. GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
  1808. If OverlapsArea(ViewPort.X1, ViewPort.Y1,
  1809. ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
  1810. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1811. HideMouseCursor; { Hide mouse cursor }
  1812. {$ENDIF}
  1813. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1814. If (HWindow <> 0) Then Begin { Valid window }
  1815. ODc := Dc; { Hold device context }
  1816. If (Dc = 0) Then Dc := GetDc(HWindow); { Get device context }
  1817. {$ENDIF}
  1818. {$IFDEF OS_OS2} { OS2 CODE }
  1819. If (HWindow <> 0) Then Begin { Valid window }
  1820. OPs := Ps; { Hold paint struct }
  1821. If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
  1822. {$ENDIF}
  1823. If (DrawMask = 0) OR (DrawMask = vdNoChild) { No special masks set }
  1824. Then Begin { Treat as a full redraw }
  1825. DrawBackGround; { Draw background }
  1826. Draw; { Draw interior }
  1827. If (GOptions AND goDrawFocus <> 0) Then
  1828. DrawFocus; { Draw focus }
  1829. If (State AND sfCursorVis <> 0)
  1830. Then DrawCursor; { Draw any cursor }
  1831. If (Options AND ofFramed <> 0) OR
  1832. (GOptions AND goThickFramed <> 0) { View has border }
  1833. Then DrawBorder; { Draw border }
  1834. End Else Begin { Masked draws only }
  1835. If (DrawMask AND vdBackGnd <> 0) Then { Chk background mask }
  1836. DrawBackGround; { Draw background }
  1837. If (DrawMask AND vdInner <> 0) Then { Check Inner mask }
  1838. Draw; { Draw interior }
  1839. If (DrawMask AND vdFocus <> 0)
  1840. AND (GOptions AND goDrawFocus <> 0)
  1841. Then DrawFocus; { Check focus mask }
  1842. If (DrawMask AND vdCursor <> 0) Then { Check cursor mask }
  1843. DrawCursor; { Draw any cursor }
  1844. If (DrawMask AND vdBorder <> 0) Then { Check border mask }
  1845. DrawBorder; { Draw border }
  1846. End;
  1847. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1848. ShowMouseCursor; { Show mouse cursor }
  1849. {$ENDIF}
  1850. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1851. If (ODc = 0) Then ReleaseDc(HWindow, Dc); { Release context }
  1852. Dc := ODc; { Reset held context }
  1853. End;
  1854. {$ENDIF}
  1855. {$IFDEF OS_OS2} { OS2 CODE }
  1856. If (OPs = 0) Then WinReleasePS(Ps); { Free paint struct }
  1857. Ps := OPs; { Reset held struct }
  1858. End;
  1859. {$ENDIF}
  1860. End;
  1861. ReleaseViewLimits; { Release the limits }
  1862. End;
  1863. DrawMask := 0; { Clear the draw mask }
  1864. END;
  1865. {--TView--------------------------------------------------------------------}
  1866. { MakeFirst -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  1867. {---------------------------------------------------------------------------}
  1868. PROCEDURE TView.MakeFirst;
  1869. BEGIN
  1870. If (Owner <> Nil) Then Begin { Must have owner }
  1871. PutInFrontOf(Owner^.First); { Float to the top }
  1872. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1873. If (HWindow <> 0) Then { Valid window }
  1874. SetWindowPos(HWindow, HWND_TOP, 0, 0, 0, 0,
  1875. swp_NoSize OR swp_NoMove); { Bring window to top }
  1876. {$ENDIF}
  1877. {$IFDEF OS_OS2} { OS2 CODE }
  1878. If (HWindow <> 0) Then { Valid window }
  1879. WinSetWindowPos(HWindow, HWND_TOP, 0, 0, 0, 0,
  1880. swp_ZOrder); { Bring window to top }
  1881. {$ENDIF}
  1882. End;
  1883. END;
  1884. {--TView--------------------------------------------------------------------}
  1885. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1886. {---------------------------------------------------------------------------}
  1887. PROCEDURE TView.DrawFocus;
  1888. BEGIN { Abstract method }
  1889. END;
  1890. {--TView--------------------------------------------------------------------}
  1891. { DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  1892. {---------------------------------------------------------------------------}
  1893. PROCEDURE TView.DrawCursor;
  1894. BEGIN { Abstract method }
  1895. END;
  1896. {--TView--------------------------------------------------------------------}
  1897. { DrawBorder -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17May98 LdB }
  1898. {---------------------------------------------------------------------------}
  1899. PROCEDURE TView.DrawBorder;
  1900. BEGIN
  1901. {$IFDEF OS_DOS} { DOS/DPMI CODE ONLY }
  1902. If (TextModeGFV = FALSE) Then Begin { GRAPHICS GFV MODE }
  1903. BiColorRectangle(0, 0, RawSize.X, RawSize.Y,
  1904. White, 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. End Else Begin { TEXT GFV MODE }
  1914. End;
  1915. {$ENDIF}
  1916. END;
  1917. {--TView--------------------------------------------------------------------}
  1918. { HideCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1919. {---------------------------------------------------------------------------}
  1920. PROCEDURE TView.HideCursor;
  1921. BEGIN
  1922. SetState(sfCursorVis , False); { Hide the cursor }
  1923. END;
  1924. {--TView--------------------------------------------------------------------}
  1925. { ShowCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1926. {---------------------------------------------------------------------------}
  1927. PROCEDURE TView.ShowCursor;
  1928. BEGIN
  1929. SetState(sfCursorVis , True); { Show the cursor }
  1930. END;
  1931. {--TView--------------------------------------------------------------------}
  1932. { BlockCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1933. {---------------------------------------------------------------------------}
  1934. PROCEDURE TView.BlockCursor;
  1935. BEGIN
  1936. SetState(sfCursorIns, True); { Set insert mode }
  1937. END;
  1938. {--TView--------------------------------------------------------------------}
  1939. { NormalCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  1940. {---------------------------------------------------------------------------}
  1941. PROCEDURE TView.NormalCursor;
  1942. BEGIN
  1943. SetState(sfCursorIns, False); { Clear insert mode }
  1944. END;
  1945. {--TView--------------------------------------------------------------------}
  1946. { FocusFromTop -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11Aug99 LdB }
  1947. {---------------------------------------------------------------------------}
  1948. PROCEDURE TView.FocusFromTop;
  1949. BEGIN
  1950. If (Owner <> Nil) AND
  1951. (Owner^.State AND sfSelected = 0)
  1952. Then Owner^.Select;
  1953. If (State AND sfFocused = 0) Then Focus;
  1954. If (State AND sfSelected = 0) Then Select;
  1955. END;
  1956. {--TView--------------------------------------------------------------------}
  1957. { SetViewLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Sep99 LdB }
  1958. {---------------------------------------------------------------------------}
  1959. PROCEDURE TView.SetViewLimits;
  1960. VAR X1, Y1, X2, Y2: Integer; P: PGroup; ViewPort: ViewPortType; Ca: PComplexArea;
  1961. BEGIN
  1962. If (MaxAvail >= SizeOf(TComplexArea)) Then Begin { Check enough memory }
  1963. GetMem(Ca, SizeOf(TComplexArea)); { Allocate memory }
  1964. GetViewSettings(ViewPort, TextModeGFV); { Fetch view port }
  1965. Ca^.X1 := ViewPort.X1; { Hold current X1 }
  1966. Ca^.Y1 := ViewPort.Y1; { Hold current Y1 }
  1967. Ca^.X2 := ViewPort.X2; { Hold current X2 }
  1968. Ca^.Y2 := ViewPort.Y2; { Hold current Y2 }
  1969. Ca^.NextArea := HoldLimit; { Pointer to next }
  1970. HoldLimit := Ca; { Move down chain }
  1971. X1 := RawOrigin.X; { Xfer x raw origin }
  1972. Y1 := RawOrigin.Y; { Xfer y raw origin }
  1973. X2 := X1 + RawSize.X; { Calc right value }
  1974. Y2 := Y1 + RawSize.Y; { Calc lower value }
  1975. P := Owner; { Start on owner }
  1976. While (P <> Nil) Do Begin { While owner valid }
  1977. If (X1 < P^.RawOrigin.X) Then
  1978. X1 := P^.RawOrigin.X; { X minimum contain }
  1979. If (Y1 < P^.RawOrigin.Y) Then
  1980. Y1 := P^.RawOrigin.Y; { Y minimum contain }
  1981. If (X2 > P^.RawOrigin.X + P^.RawSize.X)
  1982. Then X2 := P^.RawOrigin.X + P^.RawSize.X; { X maximum contain }
  1983. If (Y2 > P^.RawOrigin.Y + P^.RawSize.Y)
  1984. Then Y2 := P^.RawOrigin.Y + P^.RawSize.Y; { Y maximum contain }
  1985. P := P^.Owner; { Move to owners owner }
  1986. End;
  1987. If (LimitsLocked <> Nil) Then Begin { Locked = area redraw }
  1988. If (X2 < ViewPort.X1) Then Exit; { View left of locked }
  1989. If (X1 > ViewPort.X2) Then Exit; { View right of locked }
  1990. If (Y2 < ViewPort.Y1) Then Exit; { View above locked }
  1991. If (Y1 > ViewPort.Y2) Then Exit; { View below locked }
  1992. If (X1 < ViewPort.X1) Then X1 := ViewPort.X1; { Adjust x1 to locked }
  1993. If (Y1 < ViewPort.Y1) Then Y1 := ViewPort.Y1; { Adjust y1 to locked }
  1994. If (X2 > ViewPort.X2) Then X2 := ViewPort.X2; { Adjust x2 to locked }
  1995. If (Y2 > ViewPort.Y2) Then Y2 := ViewPort.Y2; { Adjust y2 to locked }
  1996. End;
  1997. SetViewPort(X1, Y1, X2, Y2, ClipOn, TextModeGFV);{ Set new clip limits }
  1998. End;
  1999. END;
  2000. {--TView--------------------------------------------------------------------}
  2001. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 21Sep99 LdB }
  2002. {---------------------------------------------------------------------------}
  2003. PROCEDURE TView.DrawBackGround;
  2004. VAR Bc: Byte; X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
  2005. {$IFDEF OS_DOS} X, Y: Integer; {$ENDIF}
  2006. {$IFDEF OS_OS2} Ptl: PointL; {$ENDIF}
  2007. BEGIN
  2008. If (GOptions AND goNoDrawView = 0) Then Begin { Non draw views exit }
  2009. If (State AND sfDisabled = 0) Then
  2010. Bc := GetColor(1) AND $F0 SHR 4 Else { Select back colour }
  2011. Bc := GetColor(4) AND $F0 SHR 4; { Disabled back colour }
  2012. GetViewSettings(ViewPort, TextModeGFV); { Get view settings }
  2013. If (ViewPort.X1 <= RawOrigin.X) Then X1 := 0 { Right to left edge }
  2014. Else X1 := ViewPort.X1-RawOrigin.X; { Offset from left }
  2015. If (ViewPort.Y1 <= RawOrigin.Y) Then Y1 := 0 { Right to top edge }
  2016. Else Y1 := ViewPort.Y1-RawOrigin.Y; { Offset from top }
  2017. If (ViewPort.X2 >= RawOrigin.X+RawSize.X) Then
  2018. X2 := RawSize.X Else { Right to right edge }
  2019. X2 := ViewPort.X2-RawOrigin.X; { Offset from right }
  2020. If (ViewPort.Y2 >= RawOrigin.Y+RawSize.Y) Then
  2021. Y2 := RawSize.Y Else { Right to bottom edge }
  2022. Y2 := ViewPort.Y2-RawOrigin.Y; { Offset from bottom }
  2023. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2024. If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
  2025. SetFillStyle(SolidFill, Bc); { Set fill colour }
  2026. Bar(0, 0, X2-X1, Y2-Y1); { Clear the area }
  2027. End Else Begin { TEXT MODE GFV }
  2028. X1 := (RawOrigin.X+X1) DIV SysFontWidth;
  2029. Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
  2030. X2 := (RawOrigin.X+X2) DIV SysFontWidth;
  2031. Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
  2032. If (State AND sfDisabled = 0) Then
  2033. Bc := GetColor(1) Else { Select back colour }
  2034. Bc := GetColor(4); { Disabled back colour }
  2035. For Y := Y1 To Y2 Do
  2036. For X := X1 To X2 Do Begin
  2037. Mem[$B800:$0+(Y*ScreenWidth+X)*2] := $20;
  2038. Mem[$B800:$0+(Y*ScreenWidth+X)*2+1] := Bc;
  2039. End;
  2040. End;
  2041. {$ENDIF}
  2042. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2043. If (Dc <> 0) Then Begin { Valid device context }
  2044. SelectObject(Dc, ColBrush[Bc]); { Select brush }
  2045. SelectObject(Dc, ColPen[Bc]); { Select pen }
  2046. Rectangle(Dc, X1, Y1, X2+1, Y2+1); { Clear the view area }
  2047. End;
  2048. {$ENDIF}
  2049. {$IFDEF OS_OS2} { OS2 CODE }
  2050. If (Ps <> 0) Then Begin { Valid pres space }
  2051. GpiSetColor(Ps, ColRef[Bc]); { Select colour }
  2052. Ptl.X := X1; { X1 position }
  2053. Ptl.Y := RawSize.Y - Y1; { Y1 position }
  2054. GpiMove(PS, Ptl); { Move to position }
  2055. Ptl.X := X2; { X2 position }
  2056. Ptl.Y := RawSize.Y - Y2; { Y2 position }
  2057. GpiBox(Ps, dro_Fill, Ptl, 0, 0); { Clear the view area }
  2058. End;
  2059. {$ENDIF}
  2060. End;
  2061. END;
  2062. {--TView--------------------------------------------------------------------}
  2063. { ReleaseViewLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  2064. {---------------------------------------------------------------------------}
  2065. PROCEDURE TView.ReleaseViewLimits;
  2066. VAR P: PComplexArea;
  2067. BEGIN
  2068. P := HoldLimit; { Transfer pointer }
  2069. If (P <> Nil) Then Begin { Valid complex area }
  2070. HoldLimit := P^.NextArea; { Move to prior area }
  2071. SetViewPort(P^.X1, P^.Y1, P^.X2, P^.Y2, ClipOn,
  2072. TextModeGFV); { Restore clip limits }
  2073. FreeMem(P, SizeOf(TComplexArea)); { Release memory }
  2074. End;
  2075. END;
  2076. {--TView--------------------------------------------------------------------}
  2077. { MoveTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2078. {---------------------------------------------------------------------------}
  2079. PROCEDURE TView.MoveTo (X, Y: Integer);
  2080. VAR R: TRect;
  2081. BEGIN
  2082. R.Assign(X, Y, X + Size.X, Y + Size.Y); { Assign area }
  2083. Locate(R); { Locate the view }
  2084. END;
  2085. {--TView--------------------------------------------------------------------}
  2086. { GrowTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2087. {---------------------------------------------------------------------------}
  2088. PROCEDURE TView.GrowTo (X, Y: Integer);
  2089. VAR R: TRect;
  2090. BEGIN
  2091. R.Assign(Origin.X, Origin.Y, Origin.X + X,
  2092. Origin.Y + Y); { Assign area }
  2093. Locate(R); { Locate the view }
  2094. END;
  2095. {--TView--------------------------------------------------------------------}
  2096. { SetDrawMask -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
  2097. {---------------------------------------------------------------------------}
  2098. PROCEDURE TView.SetDrawMask (Mask: Byte);
  2099. BEGIN
  2100. If (Options AND ofFramed = 0) AND { Check for no frame }
  2101. (GOptions AND goThickFramed = 0) AND { Check no thick frame }
  2102. (GOptions AND goTitled = 0) Then { Check for title }
  2103. Mask := Mask AND NOT vdBorder; { Clear border draw }
  2104. If (State AND sfCursorVis = 0) Then { Check for no cursor }
  2105. Mask := Mask AND NOT vdCursor; { Clear cursor draw }
  2106. If (GOptions AND goDrawFocus = 0) Then { Check no focus draw }
  2107. Mask := Mask AND NOT vdFocus; { Clear focus draws }
  2108. DrawMask := DrawMask OR Mask; { Set draw masks }
  2109. END;
  2110. {--TView--------------------------------------------------------------------}
  2111. { EndModal -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2112. {---------------------------------------------------------------------------}
  2113. PROCEDURE TView.EndModal (Command: Word);
  2114. VAR P: PView;
  2115. BEGIN
  2116. P := TopView; { Get top view }
  2117. If (P <> Nil) Then P^.EndModal(Command); { End modal operation }
  2118. END;
  2119. {--TView--------------------------------------------------------------------}
  2120. { SetCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  2121. {---------------------------------------------------------------------------}
  2122. PROCEDURE TView.SetCursor (X, Y: Integer);
  2123. BEGIN
  2124. Cursor.X := X; { New x position }
  2125. Cursor.Y := Y; { New y position }
  2126. If (State AND sfCursorVis <> 0) Then Begin { Cursor visible }
  2127. SetDrawMask(vdCursor); { Set draw mask }
  2128. DrawView; { Draw the cursor }
  2129. End;
  2130. END;
  2131. {--TView--------------------------------------------------------------------}
  2132. { PutInFrontOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  2133. {---------------------------------------------------------------------------}
  2134. PROCEDURE TView.PutInFrontOf (Target: PView);
  2135. VAR P, LastView: PView;
  2136. BEGIN
  2137. If (Owner <> Nil) AND (Target <> @Self) AND
  2138. (Target <> NextView) AND ((Target = Nil) OR
  2139. (Target^.Owner = Owner)) Then { Check validity }
  2140. If (State AND sfVisible = 0) Then Begin { View not visible }
  2141. Owner^.RemoveView(@Self); { Remove from list }
  2142. Owner^.InsertView(@Self, Target); { Insert into list }
  2143. End Else Begin
  2144. LastView := NextView; { Hold next view }
  2145. If (LastView <> Nil) Then Begin { Lastview is valid }
  2146. P := Target; { P is target }
  2147. While (P <> Nil) AND (P <> LastView)
  2148. Do P := P^.NextView; { Find our next view }
  2149. If (P = Nil) Then LastView := Target; { Lastview is target }
  2150. End;
  2151. State := State AND NOT sfVisible; { Temp stop drawing }
  2152. If (LastView = Target) Then
  2153. If (Owner <> Nil) Then Owner^.ReDrawArea(
  2154. RawOrigin.X, RawOrigin.Y, RawOrigin.X +
  2155. RawSize.X, RawOrigin.Y + RawSize.Y); { Redraw old area }
  2156. Owner^.RemoveView(@Self); { Remove from list }
  2157. Owner^.InsertView(@Self, Target); { Insert into list }
  2158. State := State OR sfVisible; { Allow drawing again }
  2159. If (LastView <> Target) Then DrawView; { Draw the view now }
  2160. If (Options AND ofSelectable <> 0) Then { View is selectable }
  2161. If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset current }
  2162. End;
  2163. END;
  2164. { ******************************* REMARK ****************************** }
  2165. { The original TV origin data is only adjusted incase the user uses }
  2166. { the values directly. New views should rely only on RawOrigin values. }
  2167. { ****************************** END REMARK *** Leon de Boer, 15May98 * }
  2168. {--TView--------------------------------------------------------------------}
  2169. { DisplaceBy -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB }
  2170. {---------------------------------------------------------------------------}
  2171. PROCEDURE TView.DisplaceBy (Dx, Dy: Integer);
  2172. BEGIN
  2173. RawOrigin.X := RawOrigin.X + Dx; { Displace raw x }
  2174. RawOrigin.Y := RawOrigin.Y + Dy; { Displace raw y }
  2175. Origin.X := RawOrigin.X DIV FontWidth; { Calc new x origin }
  2176. Origin.Y := RawOrigin.Y DIV FontHeight; { Calc new y origin }
  2177. END;
  2178. {--TView--------------------------------------------------------------------}
  2179. { SetCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2180. {---------------------------------------------------------------------------}
  2181. PROCEDURE TView.SetCommands (Commands: TCommandSet);
  2182. BEGIN
  2183. CommandSetChanged := CommandSetChanged OR
  2184. (CurCommandSet <> Commands); { Set change flag }
  2185. CurCommandSet := Commands; { Set command set }
  2186. END;
  2187. {--TView--------------------------------------------------------------------}
  2188. { ReDrawArea -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05May98 LdB }
  2189. {---------------------------------------------------------------------------}
  2190. PROCEDURE TView.ReDrawArea (X1, Y1, X2, Y2: Integer);
  2191. VAR HLimit: PView; ViewPort: ViewPortType;
  2192. BEGIN
  2193. GetViewSettings(ViewPort, TextModeGFV); { Hold view port }
  2194. SetViewPort(X1, Y1, X2, Y2, ClipOn, TextModeGFV); { Set new clip limits }
  2195. HLimit := LimitsLocked; { Hold lock limits }
  2196. LimitsLocked := @Self; { We are the lock view }
  2197. DrawView; { Redraw the area }
  2198. LimitsLocked := HLimit; { Release our lock }
  2199. SetViewPort(ViewPort.X1, ViewPort.Y1,
  2200. ViewPort.X2, ViewPort.Y2, ClipOn, TextModeGFV); { Reset old limits }
  2201. END;
  2202. {--TView--------------------------------------------------------------------}
  2203. { EnableCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2204. {---------------------------------------------------------------------------}
  2205. PROCEDURE TView.EnableCommands (Commands: TCommandSet);
  2206. BEGIN
  2207. CommandSetChanged := CommandSetChanged OR
  2208. (CurCommandSet * Commands <> Commands); { Set changed flag }
  2209. CurCommandSet := CurCommandSet + Commands; { Update command set }
  2210. END;
  2211. {--TView--------------------------------------------------------------------}
  2212. { DisableCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2213. {---------------------------------------------------------------------------}
  2214. PROCEDURE TView.DisableCommands (Commands: TCommandSet);
  2215. BEGIN
  2216. CommandSetChanged := CommandSetChanged OR
  2217. (CurCommandSet * Commands <> []); { Set changed flag }
  2218. CurCommandSet := CurCommandSet - Commands; { Update command set }
  2219. END;
  2220. {--TView--------------------------------------------------------------------}
  2221. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
  2222. {---------------------------------------------------------------------------}
  2223. PROCEDURE TView.SetState (AState: Word; Enable: Boolean);
  2224. VAR Command: Word;
  2225. BEGIN
  2226. If Enable Then State := State OR AState { Set state mask }
  2227. Else State := State AND NOT AState; { Clear state mask }
  2228. If (AState AND sfVisible <> 0) Then Begin { Visibilty change }
  2229. If (Owner <> Nil) AND { valid owner }
  2230. (Owner^.State AND sfExposed <> 0) { If owner exposed }
  2231. Then SetState(sfExposed, Enable); { Expose this view }
  2232. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2233. If Enable Then DrawView Else { Draw the view }
  2234. If (Owner <> Nil) Then Owner^.ReDrawArea( { Owner valid }
  2235. RawOrigin.X, RawOrigin.Y, RawOrigin.X +
  2236. RawSize.X, RawOrigin.Y + RawSize.Y); { Owner redraws area }
  2237. {$ENDIF}
  2238. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2239. If (HWindow <> 0) Then Begin { Window handle valid }
  2240. If Enable Then ShowWindow(HWindow, sw_Show) { Show the window }
  2241. Else ShowWindow(HWindow, sw_Hide); { Hide the window }
  2242. End;
  2243. {$ENDIF}
  2244. {$IFDEF OS_OS2} { OS2 CODE }
  2245. If (HWindow <> 0) Then Begin { Window handle valid }
  2246. If Enable Then WinSetWindowPos(HWindow, 0, 0,
  2247. 0, 0, 0, swp_Show) { Show the window }
  2248. Else WinSetWindowPos(HWindow, 0, 0, 0, 0, 0,
  2249. swp_Hide); { Hide the window }
  2250. End;
  2251. {$ENDIF}
  2252. If (Options AND ofSelectable <> 0) Then { View is selectable }
  2253. If (Owner <> Nil) Then Owner^.ResetCurrent; { Reset selected }
  2254. End;
  2255. If (AState AND sfFocused <> 0) Then Begin { Focus change }
  2256. If (Owner <> Nil) Then Begin { Owner valid }
  2257. If Enable Then Command := cmReceivedFocus { View gaining focus }
  2258. Else Command := cmReleasedFocus; { View losing focus }
  2259. Message(Owner, evBroadcast, Command, @Self); { Send out message }
  2260. End;
  2261. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2262. If (HWindow <> 0) Then { Window handle valid }
  2263. If Enable Then SetFocus(HWindow); { Focus the window }
  2264. {$ENDIF}
  2265. {$IFDEF OS_OS2} { OS2 CODE }
  2266. If (HWindow <> 0) Then { Window handle valid }
  2267. If Enable Then WinSetFocus(HWND_DESKTOP,
  2268. HWindow); { Focus the window }
  2269. {$ENDIF}
  2270. If (GOptions AND goDrawFocus <> 0) Then Begin { Draw focus view }
  2271. SetDrawMask(vdFocus); { Set focus draw mask }
  2272. DrawView; { Redraw focus change }
  2273. End;
  2274. End;
  2275. If (AState AND (sfCursorVis + sfCursorIns) <> 0) { Change cursor state }
  2276. Then Begin
  2277. SetDrawMask(vdCursor); { Set cursor draw mask }
  2278. DrawView; { Redraw the cursor }
  2279. End;
  2280. If (AState AND sfDisabled <> 0) Then Begin { Disbale change }
  2281. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2282. If (HWindow <> 0) Then { Window handle valid }
  2283. If Enable Then EnableWindow(HWindow, False) { Disable the window }
  2284. Else EnableWindow(HWindow, True); { Enable the window }
  2285. {$ENDIF}
  2286. {$IFDEF OS_OS2} { OS2 CODE }
  2287. If (HWindow <> 0) Then { Window handle valid }
  2288. If Enable Then WinEnableWindow(HWindow,False) { Disable the window }
  2289. Else WinEnableWindow(HWindow, True); { Enable the window }
  2290. {$ENDIF}
  2291. End;
  2292. If (AState AND sfShadow <> 0) Then Begin End; { Change shadow state }
  2293. END;
  2294. {--TView--------------------------------------------------------------------}
  2295. { SetCmdState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2296. {---------------------------------------------------------------------------}
  2297. PROCEDURE TView.SetCmdState (Commands: TCommandSet; Enable: Boolean);
  2298. BEGIN
  2299. If Enable Then EnableCommands(Commands) { Enable commands }
  2300. Else DisableCommands(Commands); { Disable commands }
  2301. END;
  2302. {--TView--------------------------------------------------------------------}
  2303. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2304. {---------------------------------------------------------------------------}
  2305. PROCEDURE TView.GetData (Var Rec);
  2306. BEGIN { Abstract method }
  2307. END;
  2308. {--TView--------------------------------------------------------------------}
  2309. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2310. {---------------------------------------------------------------------------}
  2311. PROCEDURE TView.SetData (Var Rec);
  2312. BEGIN { Abstract method }
  2313. END;
  2314. {--TView--------------------------------------------------------------------}
  2315. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  2316. {---------------------------------------------------------------------------}
  2317. { You can save data to the stream compatable with the old original TV by }
  2318. { temporarily turning off the ofGFVModeView making the call to this store }
  2319. { routine and resetting the ofGFVModeView flag after the call. }
  2320. {---------------------------------------------------------------------------}
  2321. PROCEDURE TView.Store (Var S: TStream);
  2322. VAR SaveState: Word;
  2323. BEGIN
  2324. SaveState := State; { Hold current state }
  2325. State := State AND NOT (sfActive OR sfSelected OR
  2326. sfFocused OR sfExposed); { Clear flags }
  2327. S.Write(Origin.X, 2); { Write view x origin }
  2328. S.Write(Origin.Y, 2); { Write view y origin }
  2329. S.Write(Size.X, 2); { Write view x size }
  2330. S.Write(Size.Y, 2); { Write view y size }
  2331. S.Write(Cursor.X, 2); { Write cursor x size }
  2332. S.Write(Cursor.Y, 2); { Write cursor y size }
  2333. S.Write(GrowMode, 1); { Write growmode flags }
  2334. S.Write(DragMode, 1); { Write dragmode flags }
  2335. S.Write(HelpCtx, 2); { Write help context }
  2336. S.Write(State, 2); { Write state masks }
  2337. S.Write(Options, 2); { Write options masks }
  2338. S.Write(Eventmask, 2); { Write event masks }
  2339. If (Options AND ofGFVModeView <> 0) Then Begin { GFV GRAPHICAL TVIEW }
  2340. S.Write(GOptions, 2); { Write new option masks }
  2341. S.Write(TabMask, 1); { Write new tab masks }
  2342. S.Write(RawOrigin.X, 2); { Write raw origin x point }
  2343. S.Write(RawOrigin.Y, 2); { Write raw origin y point }
  2344. S.Write(RawSize.X, 2); { Write raw x size }
  2345. S.Write(RawSize.Y, 2); { Write raw y size }
  2346. S.Write(ColourOfs, 2); { Write Palette offset }
  2347. End;
  2348. State := SaveState; { Reset state masks }
  2349. END;
  2350. {--TView--------------------------------------------------------------------}
  2351. { Locate -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB }
  2352. {---------------------------------------------------------------------------}
  2353. PROCEDURE TView.Locate (Var Bounds: TRect);
  2354. VAR {$IFDEF OS_DOS} X1, Y1, X2, Y2: Integer; {$ENDIF}
  2355. Min, Max: TPoint; R: TRect;
  2356. FUNCTION Range(Val, Min, Max: Integer): Integer;
  2357. BEGIN
  2358. If (Val < Min) Then Range := Min Else { Value to small }
  2359. If (Val > Max) Then Range := Max Else { Value to large }
  2360. Range := Val; { Value is okay }
  2361. END;
  2362. BEGIN
  2363. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2364. X1 := RawOrigin.X; { Current x origin }
  2365. Y1 := RawOrigin.Y; { Current y origin }
  2366. X2 := RawOrigin.X + RawSize.X; { Current x size }
  2367. Y2 := RawOrigin.Y + RawSize.Y; { Current y size }
  2368. {$ENDIF}
  2369. SizeLimits(Min, Max); { Get size limits }
  2370. Bounds.B.X := Bounds.A.X + Range(Bounds.B.X -
  2371. Bounds.A.X, Min.X, Max.X); { X bound limit }
  2372. Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y
  2373. - Bounds.A.Y, Min.Y, Max.Y); { Y bound limit }
  2374. GetBounds(R); { Current bounds }
  2375. If NOT Bounds.Equals(R) Then Begin { Size has changed }
  2376. ChangeBounds(Bounds); { Change bounds }
  2377. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2378. If (State AND sfVisible <> 0) AND { View is visible }
  2379. (State AND sfExposed <> 0) AND (Owner <> Nil) { Check view exposed }
  2380. Then Owner^.ReDrawArea(X1, Y1, X2, Y2); { Owner redraw }
  2381. DrawView; { Redraw the view }
  2382. {$ENDIF}
  2383. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2384. If (HWindow <> 0) Then Begin { Valid window handle }
  2385. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner }
  2386. Then MoveWindow(HWindow, RawOrigin.X-Owner^.RawOrigin.X,
  2387. RawOrigin.Y-Owner^.RawOrigin.Y, RawSize.X+1,
  2388. RawSize.Y+1, True) Else { Move window in owner }
  2389. MoveWindow(HWindow, RawOrigin.X, RawOrigin.Y,
  2390. RawSize.X+1, RawSize.Y+1, True); { Move window raw }
  2391. End;
  2392. {$ENDIF}
  2393. {$IFDEF OS_OS2} { OS2 CODE }
  2394. If (HWindow <> 0) Then Begin { Valid window handle }
  2395. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner }
  2396. Then WinSetWindowPos(HWindow, 0,
  2397. RawOrigin.X - Owner^.RawOrigin.X,
  2398. (Owner^.RawOrigin.Y + Owner^.RawSize.Y) -
  2399. (RawOrigin.Y + RawSize.Y), RawSize.X,
  2400. RawSize.Y, swp_Size OR swp_Move) Else { Move window in owner }
  2401. WinSetWindowPos(HWindow, 0, RawOrigin.X,
  2402. SysScreenHeight - (RawOrigin.Y + RawSize.Y),
  2403. RawSize.X, RawSize.Y, swp_Size OR swp_Move); { Move window raw }
  2404. End;
  2405. {$ENDIF}
  2406. End;
  2407. END;
  2408. {--TView--------------------------------------------------------------------}
  2409. { KeyEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2410. {---------------------------------------------------------------------------}
  2411. PROCEDURE TView.KeyEvent (Var Event: TEvent);
  2412. BEGIN
  2413. Repeat
  2414. GetEvent(Event); { Get next event }
  2415. Until (Event.What = evKeyDown); { Wait till keydown }
  2416. END;
  2417. {--TView--------------------------------------------------------------------}
  2418. { GetEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2419. {---------------------------------------------------------------------------}
  2420. PROCEDURE TView.GetEvent (Var Event: TEvent);
  2421. BEGIN
  2422. If (Owner <> Nil) Then Owner^.GetEvent(Event); { Event from owner }
  2423. END;
  2424. {--TView--------------------------------------------------------------------}
  2425. { PutEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2426. {---------------------------------------------------------------------------}
  2427. PROCEDURE TView.PutEvent (Var Event: TEvent);
  2428. BEGIN
  2429. If (Owner <> Nil) Then Owner^.PutEvent(Event); { Put in owner }
  2430. END;
  2431. {--TView--------------------------------------------------------------------}
  2432. { GetExtent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2433. {---------------------------------------------------------------------------}
  2434. PROCEDURE TView.GetExtent (Var Extent: TRect);
  2435. BEGIN
  2436. Extent.A.X := 0; { Zero x field }
  2437. Extent.A.Y := 0; { Zero y field }
  2438. Extent.B.X := Size.X; { Return x size }
  2439. Extent.B.Y := Size.Y; { Return y size }
  2440. END;
  2441. {--TView--------------------------------------------------------------------}
  2442. { GetBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2443. {---------------------------------------------------------------------------}
  2444. PROCEDURE TView.GetBounds (Var Bounds: TRect);
  2445. BEGIN
  2446. Bounds.A := Origin; { Get first corner }
  2447. Bounds.B.X := Origin.X + Size.X; { Calc corner x value }
  2448. Bounds.B.Y := Origin.Y + Size.Y; { Calc corner y value }
  2449. If (Owner <> Nil) Then
  2450. Bounds.Move(-Owner^.Origin.X, -Owner^.Origin.Y); { Sub owner offset }
  2451. END;
  2452. {--TView--------------------------------------------------------------------}
  2453. { SetBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 24Sep99 LdB }
  2454. {---------------------------------------------------------------------------}
  2455. PROCEDURE TView.SetBounds (Var Bounds: TRect);
  2456. VAR D, COrigin: TPoint;
  2457. BEGIN
  2458. If (Bounds.B.X > 0) AND (Bounds.B.Y > 0) { Normal text co-ords }
  2459. AND (GOptions AND goGraphView = 0) Then Begin { Normal text view }
  2460. If (Owner <> Nil) Then Begin { Owner is valid }
  2461. COrigin.X := Origin.X - Owner^.Origin.X; { Corrected x origin }
  2462. COrigin.Y := Origin.Y - Owner^.Origin.Y; { Corrected y origin }
  2463. D.X := Bounds.A.X - COrigin.X; { X origin disp }
  2464. D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp }
  2465. If ((D.X <> 0) OR (D.Y <> 0)) Then
  2466. DisplaceBy(D.X*FontWidth, D.Y*FontHeight); { Offset the view }
  2467. End Else Origin := Bounds.A; { Hold as origin }
  2468. Size.X := Bounds.B.X-Bounds.A.X; { Hold view x size }
  2469. Size.Y := Bounds.B.Y-Bounds.A.Y; { Hold view y size }
  2470. RawOrigin.X := Origin.X * FontWidth; { Raw x origin }
  2471. RawOrigin.Y := Origin.Y * FontHeight; { Raw y origin }
  2472. RawSize.X := Size.X * FontWidth - 1; { Set raw x size }
  2473. RawSize.Y := Size.Y * FontHeight - 1; { Set raw y size }
  2474. End Else Begin { Graphical co-ords }
  2475. If (Owner <> Nil) Then Begin { Owner is valid }
  2476. COrigin.X := RawOrigin.X - Owner^.RawOrigin.X; { Corrected x origin }
  2477. COrigin.Y := RawOrigin.Y - Owner^.RawOrigin.Y; { Corrected y origin }
  2478. D.X := Bounds.A.X - COrigin.X; { X origin disp }
  2479. D.Y := Bounds.A.Y - COrigin.Y; { Y origin disp }
  2480. If ((D.X <> 0) OR (D.Y <> 0)) Then
  2481. DisplaceBy(D.X, D.Y); { Offset the view }
  2482. End Else RawOrigin := Bounds.A; { Hold as origin }
  2483. RawSize.X := Abs(Bounds.B.X) - Bounds.A.X; { Set raw x size }
  2484. RawSize.Y := Abs(Bounds.B.Y) - Bounds.A.Y; { Set raw y size }
  2485. Origin.X := RawOrigin.X DIV FontWidth; { Rough x position }
  2486. Origin.Y := RawOrigin.Y DIV FontHeight; { Rough y position }
  2487. Size.X := RawSize.X DIV FontWidth; { Rough x size }
  2488. Size.Y := RawSize.Y DIV FontHeight; { Rough y size }
  2489. End;
  2490. Options := Options OR ofGFVModeView; { Now in GFV mode }
  2491. END;
  2492. {--TView--------------------------------------------------------------------}
  2493. { GetClipRect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2494. {---------------------------------------------------------------------------}
  2495. PROCEDURE TView.GetClipRect (Var Clip: TRect);
  2496. BEGIN
  2497. GetBounds(Clip); { Get current bounds }
  2498. If (Owner <> Nil) Then Clip.Intersect(Owner^.Clip);{ Intersect with owner }
  2499. Clip.Move(-Origin.X, -Origin.Y); { Sub owner origin }
  2500. END;
  2501. {--TView--------------------------------------------------------------------}
  2502. { ClearEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2503. {---------------------------------------------------------------------------}
  2504. PROCEDURE TView.ClearEvent (Var Event: TEvent);
  2505. BEGIN
  2506. Event.What := evNothing; { Clear the event }
  2507. Event.InfoPtr := @Self; { Set us as handler }
  2508. END;
  2509. {--TView--------------------------------------------------------------------}
  2510. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2511. {---------------------------------------------------------------------------}
  2512. PROCEDURE TView.HandleEvent (Var Event: TEvent);
  2513. BEGIN
  2514. If (Event.What = evMouseDown) Then { Mouse down event }
  2515. If (State AND (sfSelected OR sfDisabled) = 0) { Not selected/disabled }
  2516. AND (Options AND ofSelectable <> 0) Then { View is selectable }
  2517. If (Focus = False) OR { Not view with focus }
  2518. (Options AND ofFirstClick = 0) { Not 1st click select }
  2519. Then ClearEvent(Event); { Handle the event }
  2520. If (Event.What = evKeyDown) AND { Key down event }
  2521. (Options OR ofGFVModeView <> 0) Then Begin { GFV mode view check }
  2522. If (Owner <> Nil) AND (TabMask <> 0) AND { Owner and tab masks }
  2523. (State AND sfFocused <> 0) Then Begin { View has focus }
  2524. Case Event.KeyCode Of
  2525. kbTab: If (TabMask AND tmTab <> 0) Then { Tab key mask set }
  2526. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2527. kbEnter: If (TabMask AND tmEnter <> 0) Then { Enter key mask set }
  2528. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2529. kbShiftTab: If (TabMask AND tmShiftTab <> 0) { Shit tab mask set }
  2530. Then Owner^.FocusNext(True) Else Exit; { Focus prior view }
  2531. kbLeft: If (TabMask AND tmLeft <> 0) Then { Left arrow mask set }
  2532. Owner^.FocusNext(True) Else Exit; { Focus prior view }
  2533. kbRight: If (TabMask AND tmRight <> 0) Then { Right arrow mask set }
  2534. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2535. kbUp: If (TabMask AND tmUp <> 0) Then { Up arrow mask set }
  2536. Owner^.FocusNext(True) Else Exit; { Focus prior view }
  2537. kbDown: If (TabMask AND tmDown <> 0) Then { Down arrow mask set }
  2538. Owner^.FocusNext(False) Else Exit; { Focus next view }
  2539. Else Exit; { Not a tab key }
  2540. End;
  2541. ClearEvent(Event); { Clear handled events }
  2542. End;
  2543. End;
  2544. END;
  2545. {--TView--------------------------------------------------------------------}
  2546. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2547. {---------------------------------------------------------------------------}
  2548. PROCEDURE TView.ChangeBounds (Var Bounds: TRect);
  2549. BEGIN
  2550. SetBounds(Bounds); { Set new bounds }
  2551. DrawView; { Draw the view }
  2552. END;
  2553. {--TView--------------------------------------------------------------------}
  2554. { SizeLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2555. {---------------------------------------------------------------------------}
  2556. PROCEDURE TView.SizeLimits (Var Min, Max: TPoint);
  2557. BEGIN
  2558. Min.X := 0; { Zero x minimum }
  2559. Min.Y := 0; { Zero y minimum }
  2560. If (Owner = Nil) Then Begin
  2561. Max.X := $7FFF; { Max possible x size }
  2562. Max.Y := $7FFF; { Max possible y size }
  2563. End Else Max := Owner^.Size; { Max owner size }
  2564. END;
  2565. {--TView--------------------------------------------------------------------}
  2566. { GetCommands -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2567. {---------------------------------------------------------------------------}
  2568. PROCEDURE TView.GetCommands (Var Commands: TCommandSet);
  2569. BEGIN
  2570. Commands := CurCommandSet; { Return command set }
  2571. END;
  2572. {--TView--------------------------------------------------------------------}
  2573. { GetPeerViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2574. {---------------------------------------------------------------------------}
  2575. PROCEDURE TView.GetPeerViewPtr (Var S: TStream; Var P);
  2576. VAR Index: Integer;
  2577. BEGIN
  2578. Index := 0; { Zero index value }
  2579. S.Read(Index, 2); { Read view index }
  2580. If (Index = 0) OR (OwnerGroup = Nil) Then { Check for peer views }
  2581. Pointer(P) := Nil Else Begin { Return nil }
  2582. Pointer(P) := FixupList^[Index]; { New view ptr }
  2583. FixupList^[Index] := @P; { Patch this pointer }
  2584. End;
  2585. END;
  2586. {--TView--------------------------------------------------------------------}
  2587. { PutPeerViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2588. {---------------------------------------------------------------------------}
  2589. PROCEDURE TView.PutPeerViewPtr (Var S: TStream; P: PView);
  2590. VAR Index: Integer;
  2591. BEGIN
  2592. If (P = Nil) OR (OwnerGroup = Nil) Then Index := 0 { Return zero index }
  2593. Else Index := OwnerGroup^.IndexOf(P); { Return view index }
  2594. S.Write(Index, 2); { Write the index }
  2595. END;
  2596. {--TView--------------------------------------------------------------------}
  2597. { CalcBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2598. {---------------------------------------------------------------------------}
  2599. PROCEDURE TView.CalcBounds (Var Bounds: TRect; Delta: TPoint);
  2600. VAR S, D: Integer; Min, Max: TPoint;
  2601. FUNCTION Range (Val, Min, Max: Integer): Integer;
  2602. BEGIN
  2603. If (Val < Min) Then Range := Min Else { Value below min }
  2604. If (Val > Max) Then Range := Max Else { Value above max }
  2605. Range := Val; { Accept value }
  2606. END;
  2607. PROCEDURE Grow (Var I: Integer);
  2608. BEGIN
  2609. If (GrowMode AND gfGrowRel = 0) Then Inc(I, D)
  2610. Else I := (I * S + (S - D) SHR 1) DIV (S - D); { Calc grow value }
  2611. END;
  2612. BEGIN
  2613. GetBounds(Bounds); { Get bounds }
  2614. If (GrowMode = 0) Then Exit; { No grow flags exits }
  2615. S := Owner^.Size.X; { Set initial size }
  2616. D := Delta.X; { Set initial delta }
  2617. If (GrowMode AND gfGrowLoX <> 0) Then
  2618. Grow(Bounds.A.X); { Grow left side }
  2619. If (GrowMode AND gfGrowHiX <> 0) Then
  2620. Grow(Bounds.B.X); { Grow right side }
  2621. If (Bounds.B.X - Bounds.A.X > MaxViewWidth) Then
  2622. Bounds.B.X := Bounds.A.X + MaxViewWidth; { Check values }
  2623. S := Owner^.Size.Y; D := Delta.Y; { set initial values }
  2624. If (GrowMode AND gfGrowLoY <> 0) Then
  2625. Grow(Bounds.A.Y); { Grow top side }
  2626. If (GrowMode AND gfGrowHiY <> 0) Then
  2627. Grow(Bounds.B.Y); { grow lower side }
  2628. SizeLimits(Min, Max); { Check sizes }
  2629. Bounds.B.X := Bounds.A.X + Range(Bounds.B.X -
  2630. Bounds.A.X, Min.X, Max.X); { Set right side }
  2631. Bounds.B.Y := Bounds.A.Y + Range(Bounds.B.Y -
  2632. Bounds.A.Y, Min.Y, Max.Y); { Set lower side }
  2633. END;
  2634. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  2635. {***************************************************************************}
  2636. { TView OBJECT WIN/NT/OS2 ONLY METHODS }
  2637. {***************************************************************************}
  2638. {--TView--------------------------------------------------------------------}
  2639. { GetClassId -> Platforms WIN/NT/OS2 - Updated 29Jul99 LdB }
  2640. {---------------------------------------------------------------------------}
  2641. FUNCTION TView.GetClassId: LongInt;
  2642. BEGIN
  2643. GetClassId := 0; { No view class id }
  2644. END;
  2645. {--TView--------------------------------------------------------------------}
  2646. { GetClassName -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2647. {---------------------------------------------------------------------------}
  2648. FUNCTION TView.GetClassName: String;
  2649. BEGIN
  2650. GetClassName := TvViewClassName; { View class name }
  2651. END;
  2652. {--TView--------------------------------------------------------------------}
  2653. { GetClassText -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2654. {---------------------------------------------------------------------------}
  2655. FUNCTION TView.GetClassText: String;
  2656. BEGIN
  2657. GetClassText := ''; { Return empty string }
  2658. END;
  2659. {--TView--------------------------------------------------------------------}
  2660. { GetClassAttr -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2661. {---------------------------------------------------------------------------}
  2662. FUNCTION TView.GetClassAttr: LongInt;
  2663. VAR Li: LongInt;
  2664. BEGIN
  2665. If (State AND sfVisible = 0) Then Li := 0 { View not visible }
  2666. Else Li := ws_Visible; { View is visible }
  2667. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  2668. If (State AND sfDisabled <> 0) Then { Check disabled flag }
  2669. Li := Li OR ws_Disabled; { Set disabled flag }
  2670. If (GOptions AND goTitled <> 0) Then Begin
  2671. Li := Li OR ws_Caption; { View has a caption }
  2672. CaptSize := GetSystemMetrics(SM_CYCaption); { Caption height }
  2673. End;
  2674. If (GOptions AND goThickFramed <> 0) Then Begin
  2675. Li := Li OR ws_ThickFrame; { Thick frame on view }
  2676. FrameSize := GetSystemMetrics(SM_CXFrame); { Frame width }
  2677. If (GOptions AND goTitled = 0) Then
  2678. CaptSize := GetSystemMetrics(SM_CYFrame); { Frame height }
  2679. End Else If (Options AND ofFramed <> 0) Then Begin
  2680. Li := Li OR ws_Border; { Normal frame on view }
  2681. FrameSize := GetSystemMetrics(SM_CXBorder); { Frame width }
  2682. If (GOPtions AND goTitled = 0) Then
  2683. CaptSize := GetSystemMetrics(SM_CYBorder); { Frame height }
  2684. End;
  2685. {$ENDIF}
  2686. {$IFDEF OS_OS2} { OS2 CODE }
  2687. Li := Li OR fcf_NoByteAlign; { Not byte aligned }
  2688. If (GOptions AND goTitled <> 0) Then Begin
  2689. Li := Li OR fcf_TitleBar; { View has a caption }
  2690. CaptSize := WinQuerySysValue(HWND_Desktop,
  2691. SV_CYTitleBar); { Caption height }
  2692. End;
  2693. If (GOptions AND goThickFramed <> 0) Then Begin
  2694. Li := Li OR fcf_DlgBorder; { Thick frame on view }
  2695. FrameSize := WinQuerySysValue(HWND_DeskTop,
  2696. SV_CXSizeBorder); { Frame width }
  2697. CaptSize := CaptSize + WinQuerySysValue(
  2698. HWND_DeskTop, SV_CYSizeBorder); { Frame height }
  2699. End Else If (Options AND ofFramed <> 0) Then Begin
  2700. Li := Li OR fcf_Border; { Normal frame on view }
  2701. FrameSize := WinQuerySysValue(HWND_Desktop,
  2702. SV_CXBorder); { Frame width }
  2703. CaptSize := CaptSize + WinQuerySysValue(
  2704. HWND_DeskTop, SV_CYBorder); { Frame height }
  2705. End;
  2706. {$ENDIF}
  2707. Li := Li OR ws_ClipChildren OR ws_ClipSiblings; { By default clip others }
  2708. GetClassAttr := Li; { Return attributes }
  2709. END;
  2710. {--TView--------------------------------------------------------------------}
  2711. { GetNotifyCmd -> Platforms WIN/NT/OS2 - Updated 06Aug99 LdB }
  2712. {---------------------------------------------------------------------------}
  2713. FUNCTION TView.GetNotifyCmd: LongInt;
  2714. BEGIN
  2715. GetNotifyCmd := -1; { No notify cmd }
  2716. END;
  2717. {--TView--------------------------------------------------------------------}
  2718. { GetMsgHandler -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  2719. {---------------------------------------------------------------------------}
  2720. FUNCTION TView.GetMsgHandler: Pointer;
  2721. BEGIN
  2722. GetMsgHandler := @TvViewMsgHandler; { Default msg handler }
  2723. END;
  2724. {$ENDIF}
  2725. {***************************************************************************}
  2726. { TView OBJECT PRIVATE METHODS }
  2727. {***************************************************************************}
  2728. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2729. { TGroup OBJECT METHODS }
  2730. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2731. {--TGroup-------------------------------------------------------------------}
  2732. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul99 LdB }
  2733. {---------------------------------------------------------------------------}
  2734. CONSTRUCTOR TGroup.Init (Var Bounds: TRect);
  2735. BEGIN
  2736. Inherited Init(Bounds); { Call ancestor }
  2737. Options := Options OR (ofSelectable + ofBuffered); { Set options }
  2738. GOptions := GOptions OR goNoDrawView; { Non drawing view }
  2739. GetExtent(Clip); { Get clip extents }
  2740. EventMask := $FFFF; { See all events }
  2741. GOptions := GOptions OR goTabSelect; { Set graphic options }
  2742. END;
  2743. {--TGroup-------------------------------------------------------------------}
  2744. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  2745. {---------------------------------------------------------------------------}
  2746. CONSTRUCTOR TGroup.Load (Var S: TStream);
  2747. VAR I, Count: Word; P, Q: ^Pointer; V: PView; OwnerSave: PGroup;
  2748. FixupSave: PFixupList;
  2749. BEGIN
  2750. Inherited Load(S); { Call ancestor }
  2751. GetExtent(Clip); { Get view extents }
  2752. OwnerSave := OwnerGroup; { Save current group }
  2753. OwnerGroup := @Self; { We are current group }
  2754. FixupSave := FixupList; { Save current list }
  2755. Count := 0; { Zero count value }
  2756. S.Read(Count, 2); { Read entry count }
  2757. If (MaxAvail >= Count*SizeOf(Pointer)) Then Begin { Memory available }
  2758. GetMem(FixupList, Count*SizeOf(Pointer)); { List size needed }
  2759. FillChar(FixUpList^, Count*SizeOf(Pointer), #0); { Zero all entries }
  2760. For I := 1 To Count Do Begin
  2761. V := PView(S.Get); { Get view off stream }
  2762. If (V <> Nil) Then InsertView(V, Nil); { Insert valid views }
  2763. End;
  2764. V := Last; { Start on last view }
  2765. For I := 1 To Count Do Begin
  2766. V := V^.Next; { Fetch next view }
  2767. P := FixupList^[I]; { Transfer pointer }
  2768. While (P <> Nil) Do Begin { If valid view }
  2769. Q := P; { Copy pointer }
  2770. P := P^; { Fetch pointer }
  2771. Q^ := V; { Transfer view ptr }
  2772. End;
  2773. End;
  2774. FreeMem(FixupList, Count*SizeOf(Pointer)); { Release fixup list }
  2775. End;
  2776. OwnerGroup := OwnerSave; { Reload current group }
  2777. FixupList := FixupSave; { Reload current list }
  2778. GetSubViewPtr(S, V); { Load any subviews }
  2779. SetCurrent(V, NormalSelect); { Select current view }
  2780. If (OwnerGroup = Nil) Then Awaken; { If topview activate }
  2781. END;
  2782. {--TGroup-------------------------------------------------------------------}
  2783. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2784. {---------------------------------------------------------------------------}
  2785. DESTRUCTOR TGroup.Done;
  2786. VAR P, T: PView;
  2787. BEGIN
  2788. Hide; { Hide the view }
  2789. P := Last; { Start on last }
  2790. If (P <> Nil) Then Begin { Subviews exist }
  2791. Repeat
  2792. P^.Hide; { Hide each view }
  2793. P := P^.Prev; { Prior view }
  2794. Until (P = Last); { Loop complete }
  2795. Repeat
  2796. T := P^.Prev; { Hold prior pointer }
  2797. Dispose(P, Done); { Dispose subview }
  2798. P := T; { Transfer pointer }
  2799. Until (Last = Nil); { Loop complete }
  2800. End;
  2801. Inherited Done; { Call ancestor }
  2802. END;
  2803. {--TGroup-------------------------------------------------------------------}
  2804. { First -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2805. {---------------------------------------------------------------------------}
  2806. FUNCTION TGroup.First: PView;
  2807. BEGIN
  2808. If (Last = Nil) Then First := Nil { No first view }
  2809. Else First := Last^.Next; { Return first view }
  2810. END;
  2811. {--TGroup-------------------------------------------------------------------}
  2812. { Execute -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2813. {---------------------------------------------------------------------------}
  2814. FUNCTION TGroup.Execute: Word;
  2815. VAR Event: TEvent;
  2816. BEGIN
  2817. Repeat
  2818. EndState := 0; { Clear end state }
  2819. Repeat
  2820. GetEvent(Event); { Get next event }
  2821. HandleEvent(Event); { Handle the event }
  2822. If (Event.What <> evNothing) Then
  2823. EventError(Event); { Event not handled }
  2824. Until (EndState <> 0); { Until command set }
  2825. Until Valid(EndState); { Repeat until valid }
  2826. Execute := EndState; { Return result }
  2827. EndState := 0; { Clear end state }
  2828. END;
  2829. {--TGroup-------------------------------------------------------------------}
  2830. { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2831. {---------------------------------------------------------------------------}
  2832. FUNCTION TGroup.GetHelpCtx: Word;
  2833. VAR H: Word;
  2834. BEGIN
  2835. H := hcNoContext; { Preset no context }
  2836. If (Current <> Nil) Then H := Current^.GetHelpCtx; { Current context }
  2837. If (H=hcNoContext) Then H := Inherited GetHelpCtx; { Call ancestor }
  2838. GetHelpCtx := H; { Return result }
  2839. END;
  2840. {--TGroup-------------------------------------------------------------------}
  2841. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul98 LdB }
  2842. {---------------------------------------------------------------------------}
  2843. FUNCTION TGroup.DataSize: Word;
  2844. VAR Total: Word; P: PView;
  2845. BEGIN
  2846. Total := 0; { Zero totals count }
  2847. P := Last; { Start on last view }
  2848. If (P <> Nil) Then Begin { Subviews exist }
  2849. Repeat
  2850. P := P^.Next; { Move to next view }
  2851. Total := Total + P^.DataSize; { Add view size }
  2852. Until (P = Last); { Until last view }
  2853. End;
  2854. DataSize := Total; { Return data size }
  2855. END;
  2856. {--TGroup-------------------------------------------------------------------}
  2857. { ExecView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Jul99 LdB }
  2858. {---------------------------------------------------------------------------}
  2859. FUNCTION TGroup.ExecView (P: PView): Word;
  2860. VAR SaveOptions: Word; SaveTopView, SaveCurrent: PView; SaveOwner: PGroup;
  2861. SaveCommands: TCommandSet;
  2862. BEGIN
  2863. If (P<>Nil) Then Begin
  2864. SaveOptions := P^.Options; { Hold options }
  2865. SaveOwner := P^.Owner; { Hold owner }
  2866. SaveTopView := TheTopView; { Save topmost view }
  2867. SaveCurrent := Current; { Save current view }
  2868. GetCommands(SaveCommands); { Save commands }
  2869. TheTopView := P; { Set top view }
  2870. P^.Options := P^.Options AND NOT ofSelectable; { Not selectable }
  2871. P^.SetState(sfModal, True); { Make modal }
  2872. SetCurrent(P, EnterSelect); { Select next }
  2873. If (SaveOwner = Nil) Then Insert(P); { Insert view }
  2874. ExecView := P^.Execute; { Execute view }
  2875. If (SaveOwner = Nil) Then Delete(P); { Remove view }
  2876. SetCurrent(SaveCurrent, LeaveSelect); { Unselect current }
  2877. P^.SetState(sfModal, False); { Clear modal state }
  2878. P^.Options := SaveOptions; { Restore options }
  2879. TheTopView := SaveTopView; { Restore topview }
  2880. SetCommands(SaveCommands); { Restore commands }
  2881. End Else ExecView := cmCancel; { Return cancel }
  2882. END;
  2883. { ********************************* REMARK ******************************** }
  2884. { This call really is very COMPILER SPECIFIC and really can't be done }
  2885. { effectively any other way but assembler code as SELF & FRAMES need }
  2886. { to be put down in exact order and OPTIMIZERS make a mess of it. }
  2887. { ******************************** END REMARK *** Leon de Boer, 17Jul99 *** }
  2888. {--TGroup-------------------------------------------------------------------}
  2889. { FirstThat -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB }
  2890. {---------------------------------------------------------------------------}
  2891. FUNCTION TGroup.FirstThat (P: Pointer): PView; ASSEMBLER;
  2892. {&USES EBX, ECX, ESI, EDI} {&FRAME-}
  2893. {$IFDEF BIT_16} VAR HoldLast: Pointer; {$ENDIF}
  2894. {$IFDEF BIT_16} { 16 BIT CODE }
  2895. ASM
  2896. LES DI, Self; { Load self pointer }
  2897. LES DI, ES:[DI].TGroup.Last; { Fetch last view }
  2898. MOV AX, ES;
  2899. OR AX, DI; { Check for nil }
  2900. JZ @@Exit; { No subviews exit }
  2901. MOV WORD PTR HoldLast[2], ES;
  2902. MOV WORD PTR HoldLast[0], DI; { Hold this last view }
  2903. @@LoopPoint:
  2904. LES DI, ES:[DI].TView.Next; { Move to next view }
  2905. PUSH ES; { * Save this view for }
  2906. PUSH DI; { post call to proc P * }
  2907. PUSH ES;
  2908. PUSH DI; { Push view for proc P }
  2909. MOV AX, [BP]; { Get our frame }
  2910. {$IFNDEF OS_DOS} { WIN/OS2 CODE }
  2911. AND AL, 0FEH; { Must be even }
  2912. {$ENDIF}
  2913. PUSH AX; { Push this frame }
  2914. CALL P; { Call the procedure P }
  2915. POP DI; { * Restore the view }
  2916. POP ES; { we saved above * }
  2917. OR AL, AL; { Look for true result }
  2918. JNZ @@TrueReturned; { Branch if true }
  2919. CMP DI, WORD PTR HoldLast[0]; { HoldLast ofs match? }
  2920. JNZ @@LoopPoint; { No match the continue }
  2921. MOV AX, ES;
  2922. CMP AX, WORD PTR HoldLast[2]; { HoldLast seg match? }
  2923. JNZ @@LoopPoint; { No match continue }
  2924. XOR DI, DI;
  2925. MOV ES, DI; { No matches return nil }
  2926. @@TrueReturned:
  2927. MOV SP, BP; { Restore stack pointer }
  2928. @@Exit:
  2929. MOV AX, DI;
  2930. MOV DX, ES; { Return result pointer }
  2931. END;
  2932. {$ENDIF}
  2933. {$IFDEF BIT_32} { 32 BIT CODE }
  2934. {$IFNDEF PPC_FPC} { NONE FPC COMPILERS }
  2935. ASM
  2936. MOV EAX, Self; { Fetch self pointer }
  2937. MOV EAX, [EAX].TGroup.Last; { Fetch last view }
  2938. OR EAX, EAX; { Check for nil }
  2939. JZ @@Exit; { No subviews exit }
  2940. MOV ECX, EAX; { Hold this last view }
  2941. MOV EBX, P; { Procedure to call }
  2942. @@LoopPoint:
  2943. MOV EAX, [EAX].TView.Next; { Fetch next view }
  2944. PUSH ECX; { Save holdlast view }
  2945. PUSH EBX; { Save procedure address }
  2946. PUSH EAX; { Save for recovery }
  2947. PUSH EAX; { [1]:Pointer = PView }
  2948. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
  2949. DB $66;
  2950. DB $FF;
  2951. DB $D1; { Doesn't know CALL ECX }
  2952. {$ELSE}
  2953. CALL EBX; { Call the test function }
  2954. {$ENDIF}
  2955. TEST AL, AL; { True result check }
  2956. POP EAX; { PView recovered }
  2957. POP EBX; { Restore procedure addr }
  2958. POP ECX; { Restore holdlast view }
  2959. JNZ @@Exit; { Exit if true }
  2960. CMP EAX, ECX; { Check if last view }
  2961. JNZ @@LoopPoint; { Reloop if not last }
  2962. XOR EAX, EAX; { No matches return nil }
  2963. @@Exit:
  2964. END;
  2965. {$ELSE} { FPC COMPILER }
  2966. ASM
  2967. MOVL 8(%EBP), %ESI; { Self pointer }
  2968. MOVL TGroup.Last(%ESI), %EAX; { Load last view }
  2969. ORL %EAX, %EAX; { Check for nil }
  2970. JZ .L_Exit; { No subviews exit }
  2971. MOVL %EAX, %ECX; { Hold last view }
  2972. MOVL P, %EBX; { Procedure to call }
  2973. .L_LoopPoint:
  2974. MOVL TView.Next(%EAX), %EAX; { Fetch next pointer }
  2975. PUSHL %ECX; { Save holdlast view }
  2976. PUSHL %EBX; { Save procedure address }
  2977. PUSHL %EAX; { Save for recovery }
  2978. PUSHL %EAX; { PView pushed }
  2979. MOVL (%EBP), %EAX; { Fetch self ptr }
  2980. PUSH %EAX; { Push self ptr }
  2981. CALL %EBX; { Call the procedure }
  2982. ORB %AL, %AL; { Test for true }
  2983. POPL %EAX; { Recover next PView }
  2984. POPL %EBX; { Restore procedure addr }
  2985. POPL %ECX; { Restore holdlast view }
  2986. JNZ .L_Exit; { Call returned true }
  2987. CMPL %ECX, %EAX; { Check if last view }
  2988. JNZ .L_LoopPoint; { Continue to last }
  2989. XOR %EAX, %EAX; { No views gave true }
  2990. .L_Exit:
  2991. MOVL %EAX, -4(%EBP); { Return result }
  2992. END;
  2993. {$ENDIF}
  2994. {$ENDIF}
  2995. {--TGroup-------------------------------------------------------------------}
  2996. { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  2997. {---------------------------------------------------------------------------}
  2998. FUNCTION TGroup.Valid (Command: Word): Boolean;
  2999. FUNCTION IsInvalid (P: PView): Boolean; FAR;
  3000. BEGIN
  3001. IsInvalid := NOT P^.Valid(Command); { Check if valid }
  3002. END;
  3003. BEGIN
  3004. Valid := True; { Preset valid }
  3005. If (Command = cmReleasedFocus) Then Begin { Release focus cmd }
  3006. If (Current <> Nil) AND { Current view exists }
  3007. (Current^.Options AND ofValidate <> 0) Then { Validating view }
  3008. Valid := Current^.Valid(Command); { Validate command }
  3009. End Else Valid := FirstThat(@IsInvalid) = Nil; { Check first valid }
  3010. END;
  3011. {--TGroup-------------------------------------------------------------------}
  3012. { FocusNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3013. {---------------------------------------------------------------------------}
  3014. FUNCTION TGroup.FocusNext (Forwards: Boolean): Boolean;
  3015. VAR P: PView;
  3016. BEGIN
  3017. P := FindNext(Forwards); { Find next view }
  3018. FocusNext := True; { Preset true }
  3019. If (P <> Nil) Then FocusNext := P^.Focus; { Check next focus }
  3020. END;
  3021. {--TGroup-------------------------------------------------------------------}
  3022. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  3023. {---------------------------------------------------------------------------}
  3024. PROCEDURE TGroup.Draw;
  3025. VAR P: PView;
  3026. BEGIN
  3027. If (DrawMask AND vdNoChild = 0) Then Begin { No draw child clear }
  3028. P := Last; { Start on Last }
  3029. While (P <> Nil) Do Begin
  3030. P^.DrawView; { Redraw each subview }
  3031. P := P^.PrevView; { Move to prior view }
  3032. End;
  3033. End;
  3034. END;
  3035. {--TGroup-------------------------------------------------------------------}
  3036. { Awaken -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  3037. {---------------------------------------------------------------------------}
  3038. PROCEDURE TGroup.Awaken;
  3039. PROCEDURE DoAwaken (P: PView); FAR;
  3040. BEGIN
  3041. If (P <> Nil) Then P^.Awaken; { Awaken view }
  3042. END;
  3043. BEGIN
  3044. ForEach(@DoAwaken); { Awaken each view }
  3045. END;
  3046. {--TGroup-------------------------------------------------------------------}
  3047. { ReDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Sep97 LdB }
  3048. {---------------------------------------------------------------------------}
  3049. PROCEDURE TGroup.ReDraw;
  3050. BEGIN
  3051. DrawView; { For compatability }
  3052. END;
  3053. {--TGroup-------------------------------------------------------------------}
  3054. { SelectDefaultView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  3055. {---------------------------------------------------------------------------}
  3056. PROCEDURE TGroup.SelectDefaultView;
  3057. VAR P: PView;
  3058. BEGIN
  3059. P := Last; { Start at last }
  3060. While (P <> Nil) Do Begin
  3061. If P^.GetState(sfDefault) Then Begin { Search 1st default }
  3062. P^.Select; { Select default view }
  3063. P := Nil; { Force kick out }
  3064. End Else P := P^.PrevView; { Prior subview }
  3065. End;
  3066. END;
  3067. {--TGroup-------------------------------------------------------------------}
  3068. { Insert -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  3069. {---------------------------------------------------------------------------}
  3070. PROCEDURE TGroup.Insert (P: PView);
  3071. BEGIN
  3072. If (P <> Nil) Then { View is valid }
  3073. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3074. P^.DisplaceBy(RawOrigin.X, RawOrigin.Y) Else { We are in GFV mode }
  3075. P^.DisplaceBy(Origin.X*FontWidth,
  3076. Origin.Y*FontHeight); { Displace old view }
  3077. InsertBefore(P, First); { Insert the view }
  3078. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  3079. If (HWindow <> 0) Then { We are created }
  3080. If (P^.HWindow = 0) Then { Child not created }
  3081. P^.CreateWindowNow(0); { Create child window }
  3082. {$ENDIF}
  3083. END;
  3084. {--TGroup-------------------------------------------------------------------}
  3085. { Delete -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3086. {---------------------------------------------------------------------------}
  3087. PROCEDURE TGroup.Delete (P: PView);
  3088. VAR SaveState: Word;
  3089. BEGIN
  3090. SaveState := P^.State; { Save state }
  3091. P^.Hide; { Hide the view }
  3092. RemoveView(P); { Remove the view }
  3093. P^.Owner := Nil; { Clear owner ptr }
  3094. P^.Next := Nil; { Clear next ptr }
  3095. If (SaveState AND sfVisible <> 0) Then P^.Show; { Show view }
  3096. END;
  3097. { ********************************* REMARK ******************************** }
  3098. { This call really is very COMPILER SPECIFIC and really can't be done }
  3099. { effectively any other way but assembler code as SELF & FRAMES need }
  3100. { to be put down in exact order and OPTIMIZERS make a mess of it. }
  3101. { ******************************** END REMARK *** Leon de Boer, 17Jul99 *** }
  3102. {--TGroup-------------------------------------------------------------------}
  3103. { ForEach -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB }
  3104. {---------------------------------------------------------------------------}
  3105. PROCEDURE TGroup.ForEach (P: Pointer); ASSEMBLER;
  3106. {&USES EBX, ECX, EDI} {&FRAME-}
  3107. VAR HoldLast: Pointer;
  3108. {$IFDEF BIT_16} { 16 BIT CODE }
  3109. ASM
  3110. LES DI, Self; { Load self pointer }
  3111. LES DI, ES:[DI].TGroup.Last; { Fetch last view }
  3112. MOV AX, ES;
  3113. OR AX, DI; { Check for nil }
  3114. JZ @@Exit; { No subviews exit }
  3115. MOV WORD PTR HoldLast[2], ES;
  3116. MOV WORD PTR HoldLast[0], DI; { Hold this last view }
  3117. LES DI, ES:[DI].TView.Next; { Move to next view }
  3118. @@LoopPoint:
  3119. CMP DI, WORD PTR HoldLast[0]; { HoldLast ofs match? }
  3120. JNZ @@2; { No match continue }
  3121. MOV AX, ES;
  3122. CMP AX, WORD PTR HoldLast[2]; { HoldLast seg match? }
  3123. JZ @@3; { Branch if last }
  3124. @@2:
  3125. PUSH WORD PTR ES:[DI].TView.Next[2]; { * Save this view }
  3126. PUSH WORD PTR ES:[DI].TView.Next[0]; { for recovery later * }
  3127. PUSH ES;
  3128. PUSH DI; { Push view to test }
  3129. MOV AX, [BP]; { Get our frame }
  3130. {$IFNDEF OS_DOS} { WIN/OS2 CODE }
  3131. AND AL, 0FEH; { Must be even }
  3132. {$ENDIF}
  3133. PUSH AX; { Push our frame }
  3134. CALL P; { Call the proc P }
  3135. POP DI; { * Recover the view }
  3136. POP ES; { we saved earlier * }
  3137. JMP @@LoopPoint; { Continue on }
  3138. @@3:
  3139. MOV AX, [BP]; { Get our frame }
  3140. {$IFNDEF OS_DOS} { WIN/OS2 CODE }
  3141. AND AL, 0FEH; { Must be even }
  3142. {$ENDIF}
  3143. PUSH AX; { Push our frame }
  3144. CALL P; { Call the proc P }
  3145. @@Exit:
  3146. END;
  3147. {$ENDIF}
  3148. {$IFDEF BIT_32} { 32 BIT CODE }
  3149. {$IFNDEF PPC_FPC} { NON FPC COMPILERS }
  3150. ASM
  3151. MOV ECX, Self; { Load self pointer }
  3152. MOV ECX, [ECX].TGroup.Last; { Fetch last view }
  3153. OR ECX, ECX; { Check for nil }
  3154. JZ @@Exit; { No subviews exit }
  3155. MOV HoldLast, ECX; { Hold last view }
  3156. MOV ECX, [ECX].TView.Next; { Fetch next pointer }
  3157. MOV EBX, P; { Fetch proc address }
  3158. @@LoopPoint:
  3159. CMP ECX, HoldLast; { Check if last view }
  3160. JZ @@2; { Branch if last view }
  3161. MOV EAX, [ECX].TView.Next; { Fetch next view }
  3162. PUSH EBX; { Save procedure address }
  3163. PUSH EAX; { Save next view }
  3164. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  3165. MOV EAX, ECX; { Use register parameter }
  3166. MOV ESI, ECX;
  3167. {$ELSE} { OTHER COMPILERS }
  3168. PUSH ECX; { Push view to do }
  3169. {$ENDIF}
  3170. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
  3171. DB $66;
  3172. DB $FF;
  3173. DB $D3; { Can't do CALL EBX }
  3174. {$ELSE}
  3175. CALL EBX; { Call the proc P }
  3176. {$ENDIF}
  3177. POP ECX; { Recover saved view }
  3178. POP EBX; { Recover procedure addr }
  3179. JMP @@LoopPoint; { Continue on }
  3180. @@2:
  3181. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILERS }
  3182. MOV EAX, ECX; { Use register parameter }
  3183. {$ELSE} { OTHER COMPILERS }
  3184. PUSH ECX; { Push view to do }
  3185. {$ENDIF}
  3186. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL 2.0+ }
  3187. DB $66;
  3188. DB $FF;
  3189. DB $D3; { Can't do CALL EBX }
  3190. {$ELSE}
  3191. CALL EBX; { Call the proc P }
  3192. {$ENDIF}
  3193. @@Exit:
  3194. END;
  3195. {$ELSE} { FPC COMPILER }
  3196. ASM
  3197. MOVL 8(%EBP), %ESI; { Self pointer }
  3198. MOVL TGroup.Last(%ESI), %ECX; { Load last view }
  3199. ORL %ECX, %ECX; { Check for nil }
  3200. JZ .L_Exit; { No subviews exit }
  3201. MOVL %ECX, HOLDLAST; { Hold last view }
  3202. MOVL TView.Next(%ECX), %ECX; { Fetch next pointer }
  3203. .L_LoopPoint:
  3204. MOVL P, %EBX; { Fetch proc address }
  3205. CMPL HOLDLAST, %ECX; { Check if last view }
  3206. JZ .L_2; { Exit if last view }
  3207. MOVL TView.Next(%ECX), %EAX; { Fetch next pointer }
  3208. PUSHL %EAX; { Save next view ptr }
  3209. PUSHL %ECX; { Push view to do }
  3210. MOVL (%EBP), %EAX;
  3211. PUSH %EAX;
  3212. CALL %EBX; { Call the procedure }
  3213. POPL %ECX; { Recover next view }
  3214. JMP .L_LoopPoint; { Redo loop }
  3215. .L_2:
  3216. PUSHL %ECX; { Push view to do }
  3217. MOVL (%EBP), %EAX;
  3218. PUSH %EAX;
  3219. CALL %EBX; { Call the procedure }
  3220. .L_Exit:
  3221. END;
  3222. {$ENDIF}
  3223. {$ENDIF}
  3224. {--TGroup-------------------------------------------------------------------}
  3225. { EndModal -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3226. {---------------------------------------------------------------------------}
  3227. PROCEDURE TGroup.EndModal (Command: Word);
  3228. BEGIN
  3229. If (State AND sfModal <> 0) Then { This view is modal }
  3230. EndState := Command Else { Set endstate }
  3231. Inherited EndModal(Command); { Call ancestor }
  3232. END;
  3233. {--TGroup-------------------------------------------------------------------}
  3234. { DisplaceBy -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB }
  3235. {---------------------------------------------------------------------------}
  3236. PROCEDURE TGroup.DisplaceBy (Dx, Dy: Integer);
  3237. VAR P: PView;
  3238. BEGIN
  3239. P := First; { Get first view }
  3240. While (P <> Nil) Do Begin
  3241. P^.DisplaceBy(Dx, Dy); { Displace subviews }
  3242. P := P^.NextView; { Next view }
  3243. End;
  3244. Inherited DisplaceBy(Dx, Dy); { Call ancestor }
  3245. END;
  3246. {--TGroup-------------------------------------------------------------------}
  3247. { SelectNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  3248. {---------------------------------------------------------------------------}
  3249. PROCEDURE TGroup.SelectNext (Forwards: Boolean);
  3250. VAR P: PView;
  3251. BEGIN
  3252. P := FindNext(Forwards); { Find next view }
  3253. If (P <> Nil) Then P^.Select; { Select view }
  3254. END;
  3255. {--TGroup-------------------------------------------------------------------}
  3256. { InsertBefore -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Sep99 LdB }
  3257. {---------------------------------------------------------------------------}
  3258. PROCEDURE TGroup.InsertBefore (P, Target: PView);
  3259. VAR SaveState, I: Word;
  3260. BEGIN
  3261. If (P <> Nil) AND (P^.Owner = Nil) AND { View valid }
  3262. ((Target = Nil) OR (Target^.Owner = @Self)) { Target valid }
  3263. Then Begin
  3264. If (P^.Options AND ofCenterX <> 0) Then Begin { Centre on x axis }
  3265. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3266. I := RawSize.X Else I := Size.X * FontWidth; { Calc owner x size }
  3267. If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check }
  3268. Then Begin
  3269. I := (I - P^.RawSize.X) DIV 2; { Calc view offset }
  3270. I := I - P^.RawOrigin.X; { Subtract x origin }
  3271. End Else Begin
  3272. I := (I - (P^.Size.X * FontWidth)) DIV 2; { Calc view offset }
  3273. I := I - (P^.Origin.X * FontWidth); { Subtract x origin }
  3274. End;
  3275. P^.DisplaceBy(I, 0); { Displace the view }
  3276. End;
  3277. If (P^.Options AND ofCenterY <> 0) Then Begin { Centre on y axis }
  3278. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3279. I := RawSize.Y Else I := Size.Y * FontHeight;{ Calc owner y size }
  3280. If (P^.Options AND ofGFVModeView <> 0) { GFV mode view check }
  3281. Then Begin
  3282. I := (I - P^.RawSize.Y) DIV 2; { Calc view offset }
  3283. I := I - P^.RawOrigin.Y; { Subtract y origin }
  3284. End Else Begin
  3285. I := (I - (P^.Size.Y * FontHeight)) DIV 2; { Calc view offset }
  3286. I := I - (P^.Origin.Y * FontHeight); { Subtract y origin }
  3287. End;
  3288. P^.DisplaceBy(0, I); { Displace the view }
  3289. End;
  3290. SaveState := P^.State; { Save view state }
  3291. P^.Hide; { Make sure hidden }
  3292. InsertView(P, Target); { Insert into list }
  3293. If (SaveState AND sfVisible <> 0) Then P^.Show; { Show the view }
  3294. If (State AND sfActive <> 0) Then { Was active before }
  3295. P^.SetState(sfActive , True); { Make active again }
  3296. End;
  3297. END;
  3298. {--TGroup-------------------------------------------------------------------}
  3299. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3300. {---------------------------------------------------------------------------}
  3301. PROCEDURE TGroup.SetState (AState: Word; Enable: Boolean);
  3302. PROCEDURE DoSetState (P: PView); FAR;
  3303. BEGIN
  3304. If (P <> Nil) Then P^.SetState(AState, Enable); { Set subview state }
  3305. END;
  3306. PROCEDURE DoExpose (P: PView); FAR;
  3307. BEGIN
  3308. If (P <> Nil) Then Begin
  3309. If (P^.State AND sfVisible <> 0) Then { Check view visible }
  3310. P^.SetState(sfExposed, Enable); { Set exposed flag }
  3311. End;
  3312. END;
  3313. BEGIN
  3314. Inherited SetState(AState, Enable); { Call ancestor }
  3315. Case AState Of
  3316. sfActive, sfDragging: Begin
  3317. Lock; { Lock the view }
  3318. ForEach(@DoSetState); { Set each subview }
  3319. UnLock; { Unlock the view }
  3320. End;
  3321. sfFocused: If (Current <> Nil) Then
  3322. Current^.SetState(sfFocused, Enable); { Focus current view }
  3323. sfExposed: Begin
  3324. ForEach(@DoExpose); { Expose each subview }
  3325. End;
  3326. End;
  3327. END;
  3328. {--TGroup-------------------------------------------------------------------}
  3329. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Mar98 LdB }
  3330. {---------------------------------------------------------------------------}
  3331. PROCEDURE TGroup.GetData (Var Rec);
  3332. VAR Total: Word; P: PView;
  3333. BEGIN
  3334. Total := 0; { Clear total }
  3335. P := Last; { Start at last }
  3336. While (P <> Nil) Do Begin { Subviews exist }
  3337. P^.GetData(TByteArray(Rec)[Total]); { Get data }
  3338. Inc(Total, P^.DataSize); { Increase total }
  3339. P := P^.PrevView; { Previous view }
  3340. End;
  3341. END;
  3342. {--TGroup-------------------------------------------------------------------}
  3343. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Mar98 LdB }
  3344. {---------------------------------------------------------------------------}
  3345. PROCEDURE TGroup.SetData (Var Rec);
  3346. VAR Total: Word; P: PView;
  3347. BEGIN
  3348. Total := 0; { Clear total }
  3349. P := Last; { Start at last }
  3350. While (P <> Nil) Do Begin { Subviews exist }
  3351. P^.SetData(TByteArray(Rec)[Total]); { Get data }
  3352. Inc(Total, P^.DataSize); { Increase total }
  3353. P := P^.PrevView; { Previous view }
  3354. End;
  3355. END;
  3356. {--TGroup-------------------------------------------------------------------}
  3357. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB }
  3358. {---------------------------------------------------------------------------}
  3359. PROCEDURE TGroup.Store (Var S: TStream);
  3360. VAR Count: Integer; OwnerSave: PGroup;
  3361. PROCEDURE DoPut (P: PView); FAR;
  3362. BEGIN
  3363. S.Put(P); { Put view on stream }
  3364. END;
  3365. BEGIN
  3366. TView.Store(S); { Call view store }
  3367. OwnerSave := OwnerGroup; { Save ownergroup }
  3368. OwnerGroup := @Self; { Set as owner group }
  3369. Count := IndexOf(Last); { Subview count }
  3370. S.Write(Count, 2); { Write the count }
  3371. ForEach(@DoPut); { Put each in stream }
  3372. PutSubViewPtr(S, Current); { Current on stream }
  3373. OwnerGroup := OwnerSave; { Restore ownergroup }
  3374. END;
  3375. {--TGroup-------------------------------------------------------------------}
  3376. { EventError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3377. {---------------------------------------------------------------------------}
  3378. PROCEDURE TGroup.EventError (Var Event: TEvent);
  3379. BEGIN
  3380. If (Owner <> Nil) Then Owner^.EventError(Event); { Event error }
  3381. END;
  3382. {--TGroup-------------------------------------------------------------------}
  3383. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3384. {---------------------------------------------------------------------------}
  3385. PROCEDURE TGroup.HandleEvent (Var Event: TEvent);
  3386. FUNCTION ContainsMouse (P: PView): Boolean; FAR;
  3387. BEGIN
  3388. ContainsMouse := (P^.State AND sfVisible <> 0) { Is view visible }
  3389. AND P^.MouseInView(Event.Where); { Is point in view }
  3390. END;
  3391. PROCEDURE DoHandleEvent (P: PView); FAR;
  3392. BEGIN
  3393. If (P = Nil) OR ((P^.State AND sfDisabled <> 0) AND
  3394. (Event.What AND(PositionalEvents OR FocusedEvents) <>0 ))
  3395. Then Exit; { Invalid/disabled }
  3396. Case Phase Of
  3397. phPreProcess: If (P^.Options AND ofPreProcess = 0)
  3398. Then Exit; { Not pre processing }
  3399. phPostProcess: If (P^.Options AND ofPostProcess = 0)
  3400. Then Exit; { Not post processing }
  3401. End;
  3402. If (Event.What AND P^.EventMask <> 0) Then { View handles event }
  3403. P^.HandleEvent(Event); { Pass to view }
  3404. END;
  3405. BEGIN
  3406. Inherited HandleEvent(Event); { Call ancestor }
  3407. If (Event.What = evNothing) Then Exit; { No valid event exit }
  3408. If (Event.What AND FocusedEvents <> 0) Then Begin { Focused event }
  3409. Phase := phPreProcess; { Set pre process }
  3410. ForEach(@DoHandleEvent); { Pass to each view }
  3411. Phase := phFocused; { Set focused }
  3412. DoHandleEvent(Current); { Pass to current }
  3413. Phase := phPostProcess; { Set post process }
  3414. ForEach(@DoHandleEvent); { Pass to each }
  3415. End Else Begin
  3416. Phase := phFocused; { Set focused }
  3417. If (Event.What AND PositionalEvents <> 0) Then { Positional event }
  3418. DoHandleEvent(FirstThat(@ContainsMouse)) { Pass to first }
  3419. Else ForEach(@DoHandleEvent); { Pass to all }
  3420. End;
  3421. END;
  3422. {--TGroup-------------------------------------------------------------------}
  3423. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  3424. {---------------------------------------------------------------------------}
  3425. PROCEDURE TGroup.ChangeBounds (Var Bounds: TRect);
  3426. VAR D: TPoint;
  3427. PROCEDURE DoCalcChange (P: PView); FAR;
  3428. VAR R: TRect;
  3429. BEGIN
  3430. P^.CalcBounds(R, D); { Calc view bounds }
  3431. P^.ChangeBounds(R); { Change view bounds }
  3432. END;
  3433. BEGIN
  3434. D.X := Bounds.B.X - Bounds.A.X - Size.X; { Delta x value }
  3435. D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y; { Delta y value }
  3436. If ((D.X=0) AND (D.Y=0)) Then Begin
  3437. SetBounds(Bounds); { Set new bounds }
  3438. DrawView; { Draw the view }
  3439. End Else Begin
  3440. SetBounds(Bounds); { Set new bounds }
  3441. GetExtent(Clip); { Get new clip extents }
  3442. Lock; { Lock drawing }
  3443. ForEach(@DoCalcChange); { Change each view }
  3444. UnLock; { Unlock drawing }
  3445. End;
  3446. END;
  3447. {--TGroup-------------------------------------------------------------------}
  3448. { GetSubViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB }
  3449. {---------------------------------------------------------------------------}
  3450. PROCEDURE TGroup.GetSubViewPtr (Var S: TStream; Var P);
  3451. VAR Index, I: Word; Q: PView;
  3452. BEGIN
  3453. Index := 0; { Zero index value }
  3454. S.Read(Index, 2); { Read view index }
  3455. If (Index > 0) Then Begin { Valid index }
  3456. Q := Last; { Start on last }
  3457. For I := 1 To Index Do Q := Q^.Next; { Loop for count }
  3458. Pointer(P) := Q; { Return the view }
  3459. End Else Pointer(P) := Nil; { Return nil }
  3460. END;
  3461. {--TGroup-------------------------------------------------------------------}
  3462. { PutSubViewPtr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 20May98 LdB }
  3463. {---------------------------------------------------------------------------}
  3464. PROCEDURE TGroup.PutSubViewPtr (Var S: TStream; P: PView);
  3465. VAR Index: Word;
  3466. BEGIN
  3467. If (P = Nil) Then Index := 0 Else { Nil view, Index = 0 }
  3468. Index := IndexOf(P); { Calc view index }
  3469. S.Write(Index, 2); { Write the index }
  3470. END;
  3471. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  3472. {***************************************************************************}
  3473. { TGroup OBJECT WIN/NT/OS2 ONLY METHODS }
  3474. {***************************************************************************}
  3475. {--TGroup-------------------------------------------------------------------}
  3476. { CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 23Mar98 LdB }
  3477. {---------------------------------------------------------------------------}
  3478. PROCEDURE TGroup.CreateWindowNow (CmdShow: Integer);
  3479. VAR P: PView;
  3480. BEGIN
  3481. Inherited CreateWindowNow (CmdShow); { Call ancestor }
  3482. P := Last; { Start on Last }
  3483. While (P <> Nil) Do Begin
  3484. If (P^.HWindow = 0) Then { No window created }
  3485. P^.CreateWindowNow(0); { Create each subview }
  3486. P := P^.PrevView; { Move to prev view }
  3487. End;
  3488. END;
  3489. {$ENDIF}
  3490. {***************************************************************************}
  3491. { TGroup OBJECT PRIVATE METHODS }
  3492. {***************************************************************************}
  3493. {--TGroup-------------------------------------------------------------------}
  3494. { IndexOf -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3495. {---------------------------------------------------------------------------}
  3496. FUNCTION TGroup.IndexOf (P: PView): Integer;
  3497. VAR I: Integer; Q: PView;
  3498. BEGIN
  3499. Q := Last; { Start on last view }
  3500. If (Q <> Nil) Then Begin { Subviews exist }
  3501. I := 1; { Preset value }
  3502. While (Q <> P) AND (Q^.Next <> Last) Do Begin
  3503. Q := Q^.Next; { Load next view }
  3504. Inc(I); { Increment count }
  3505. End;
  3506. If (Q <> P) Then IndexOf := 0 Else IndexOf := I; { Return index }
  3507. End Else IndexOf := 0; { Return zero }
  3508. END;
  3509. {--TGroup-------------------------------------------------------------------}
  3510. { FindNext -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
  3511. {---------------------------------------------------------------------------}
  3512. FUNCTION TGroup.FindNext (Forwards: Boolean): PView;
  3513. VAR P: PView;
  3514. BEGIN
  3515. FindNext := Nil; { Preset nil return }
  3516. If (Current <> Nil) Then Begin { Has current view }
  3517. P := Current; { Start on current }
  3518. Repeat
  3519. If Forwards Then P := P^.Next { Get next view }
  3520. Else P := P^.Prev; { Get prev view }
  3521. Until ((P^.State AND (sfVisible+sfDisabled) = sfVisible)
  3522. AND ((P^.Options AND ofSelectable <> 0) AND { Selectable }
  3523. (P^.GOptions AND goTabSelect <> 0))) OR { Tab selectable }
  3524. (P = Current); { Not singular select }
  3525. If (P <> Current) Then FindNext := P; { Return result }
  3526. End;
  3527. END;
  3528. {--TGroup-------------------------------------------------------------------}
  3529. { FirstMatch -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3530. {---------------------------------------------------------------------------}
  3531. FUNCTION TGroup.FirstMatch (AState: Word; AOptions: Word): PView;
  3532. FUNCTION Matches (P: PView): Boolean; FAR;
  3533. BEGIN
  3534. Matches := (P^.State AND AState = AState) AND
  3535. (P^.Options AND AOptions = AOptions); { Return match state }
  3536. END;
  3537. BEGIN
  3538. FirstMatch := FirstThat(@Matches); { Return first match }
  3539. END;
  3540. {--TGroup-------------------------------------------------------------------}
  3541. { ResetCurrent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3542. {---------------------------------------------------------------------------}
  3543. PROCEDURE TGroup.ResetCurrent;
  3544. BEGIN
  3545. SetCurrent(FirstMatch(sfVisible, ofSelectable),
  3546. NormalSelect); { Reset current view }
  3547. END;
  3548. {--TGroup-------------------------------------------------------------------}
  3549. { RemoveView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3550. {---------------------------------------------------------------------------}
  3551. PROCEDURE TGroup.RemoveView (P: PView);
  3552. VAR Q: PView;
  3553. BEGIN
  3554. If (P <> Nil) AND (Last <> Nil) Then Begin { Check view is valid }
  3555. Q := Last; { Start on last view }
  3556. While (Q^.Next <> P) AND (Q^.Next <> Last) Do
  3557. Q := Q^.Next; { Find prior view }
  3558. If (Q^.Next = P) Then Begin { View found }
  3559. If (Q^.Next <> Q) Then Begin { Not only view }
  3560. Q^.Next := P^.Next; { Rechain views }
  3561. If (P = Last) Then Last := P^.Next; { Fix if last removed }
  3562. End Else Last := Nil; { Only view }
  3563. End;
  3564. End;
  3565. END;
  3566. {--TGroup-------------------------------------------------------------------}
  3567. { InsertView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  3568. {---------------------------------------------------------------------------}
  3569. PROCEDURE TGroup.InsertView (P, Target: PView);
  3570. BEGIN
  3571. If (P <> Nil) Then Begin { Check view is valid }
  3572. P^.Owner := @Self; { Views owner is us }
  3573. If (Target <> Nil) Then Begin { Valid target }
  3574. Target := Target^.Prev; { 1st part of chain }
  3575. P^.Next := Target^.Next; { 2nd part of chain }
  3576. Target^.Next := P; { Chain completed }
  3577. End Else Begin
  3578. If (Last <> Nil) Then Begin { Not first view }
  3579. P^.Next := Last^.Next; { 1st part of chain }
  3580. Last^.Next := P; { Completed chain }
  3581. End Else P^.Next := P; { 1st chain to self }
  3582. Last := P; { P is now last }
  3583. End;
  3584. End;
  3585. END;
  3586. {--TGroup-------------------------------------------------------------------}
  3587. { SetCurrent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep99 LdB }
  3588. {---------------------------------------------------------------------------}
  3589. PROCEDURE TGroup.SetCurrent (P: PView; Mode: SelectMode);
  3590. PROCEDURE SelectView (P: PView; Enable: Boolean);
  3591. BEGIN
  3592. If (P <> Nil) Then { View is valid }
  3593. P^.SetState(sfSelected, Enable); { Select the view }
  3594. END;
  3595. PROCEDURE FocusView (P: PView; Enable: Boolean);
  3596. BEGIN
  3597. If (State AND sfFocused <> 0) AND (P <> Nil) { Check not focused }
  3598. Then P^.SetState(sfFocused, Enable); { Focus the view }
  3599. END;
  3600. BEGIN
  3601. If (Current<>P) Then Begin { Not already current }
  3602. Lock; { Stop drawing }
  3603. FocusView(Current, False); { Defocus current }
  3604. If (Mode <> EnterSelect) Then
  3605. SelectView(Current, False); { Deselect current }
  3606. If (Mode<>LeaveSelect) Then SelectView(P, True); { Select view P }
  3607. FocusView(P, True); { Focus view P }
  3608. Current := P; { Set as current view }
  3609. UnLock; { Redraw now }
  3610. End;
  3611. END;
  3612. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3613. { TFrame OBJECT METHODS }
  3614. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3615. {--TFrame-------------------------------------------------------------------}
  3616. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  3617. {---------------------------------------------------------------------------}
  3618. CONSTRUCTOR TFrame.Init (Var Bounds: TRect);
  3619. BEGIN
  3620. Inherited Init(Bounds); { Call ancestor }
  3621. GrowMode := gfGrowHiX + gfGrowHiY; { Set grow modes }
  3622. EventMask := EventMask OR evBroadcast; { See broadcasts }
  3623. END;
  3624. {--TFrame-------------------------------------------------------------------}
  3625. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  3626. {---------------------------------------------------------------------------}
  3627. FUNCTION TFrame.GetPalette: PPalette;
  3628. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  3629. CONST P: String = CFrame; { Possible huge string }
  3630. {$ELSE} { OTHER COMPILERS }
  3631. CONST P: String[Length(CFrame)] = CFrame; { Always normal string }
  3632. {$ENDIF}
  3633. BEGIN
  3634. GetPalette := @P; { Return palette }
  3635. END;
  3636. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3637. { TScrollBar OBJECT METHODS }
  3638. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3639. {---------------------------------------------------------------------------}
  3640. { TScrollBar WINDOW CLASS NAME CONSTANT }
  3641. {---------------------------------------------------------------------------}
  3642. {$IFDEF OS_WINDOWS} { WIN/NT CLASSNAME }
  3643. CONST TvScrollBarName = 'SCROLLBAR'; { Native classname }
  3644. {$ENDIF}
  3645. {$IFDEF OS_OS2} { OS2 CLASSNAME }
  3646. CONST TvScrollBarName = '#8'; { Native classname }
  3647. {$ENDIF}
  3648. {--TScrollBar---------------------------------------------------------------}
  3649. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3650. {---------------------------------------------------------------------------}
  3651. CONSTRUCTOR TScrollBar.Init (Var Bounds: TRect);
  3652. CONST VChars: TScrollChars = (#30, #31, #177, #254, #178);
  3653. HChars: TScrollChars = (#17, #16, #177, #254, #178);
  3654. BEGIN
  3655. Inherited Init(Bounds); { Call ancestor }
  3656. {$IFDEF OS_OS2} { OS2 CODE }
  3657. If (Size.X = 1) Then RawSize.X := WinQuerySysValue(
  3658. HWND_Desktop, SV_CXVScroll) Else
  3659. RawSize.Y := WinQuerySysValue(HWND_Desktop,
  3660. SV_CYHScroll); { Set approp size }
  3661. {$ENDIF}
  3662. PgStep := 1; { Page step size = 1 }
  3663. ArStep := 1; { Arrow step sizes = 1 }
  3664. If (Size.X = 1) Then Begin { Vertical scrollbar }
  3665. GrowMode := gfGrowLoX + gfGrowHiX + gfGrowHiY; { Grow vertically }
  3666. Chars := VChars; { Vertical chars }
  3667. End Else Begin { Horizontal scrollbar }
  3668. GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY; { Grow horizontal }
  3669. Chars := HChars; { Horizontal chars }
  3670. End;
  3671. END;
  3672. {--TScrollBar---------------------------------------------------------------}
  3673. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3674. {---------------------------------------------------------------------------}
  3675. { This load method will read old original TV data from a stream with the }
  3676. { scrollbar id set to zero. }
  3677. {---------------------------------------------------------------------------}
  3678. CONSTRUCTOR TScrollBar.Load (Var S: TStream);
  3679. BEGIN
  3680. Inherited Load(S); { Call ancestor }
  3681. S.Read(Value, 2); { Read current value }
  3682. S.Read(Min , 2); { Read min value }
  3683. S.Read(Max, 2); { Read max value }
  3684. S.Read(PgStep, 2); { Read page step size }
  3685. S.Read(ArStep, 2); { Read arrow step size }
  3686. S.Read(Chars, SizeOf(Chars)); { Read scroll chars }
  3687. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3688. S.Read(Id, 2); { Read id }
  3689. END;
  3690. {--TScrollBar---------------------------------------------------------------}
  3691. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3692. {---------------------------------------------------------------------------}
  3693. FUNCTION TScrollBar.GetPalette: PPalette;
  3694. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  3695. CONST P: String = CScrollBar; { Possible huge string }
  3696. {$ELSE} { OTHER COMPILERS }
  3697. CONST P: String[Length(CScrollBar)] = CScrollBar; { Always normal string }
  3698. {$ENDIF}
  3699. BEGIN
  3700. GetPalette := @P; { Return palette }
  3701. END;
  3702. {--TScrollBar---------------------------------------------------------------}
  3703. { ScrollStep -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3704. {---------------------------------------------------------------------------}
  3705. FUNCTION TScrollBar.ScrollStep (Part: Integer): Integer;
  3706. VAR Step: Integer;
  3707. BEGIN
  3708. If (Part AND $0002 = 0) Then Step := ArStep { Range step size }
  3709. Else Step := PgStep; { Page step size }
  3710. If (Part AND $0001 = 0) Then ScrollStep := -Step { Upwards move }
  3711. Else ScrollStep := Step; { Downwards move }
  3712. END;
  3713. {--TScrollBar---------------------------------------------------------------}
  3714. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  3715. {---------------------------------------------------------------------------}
  3716. PROCEDURE TScrollBar.Draw;
  3717. BEGIN
  3718. If (GOptions AND goNativeClass = 0) Then
  3719. DrawPos(GetPos); { Draw position }
  3720. END;
  3721. {--TScrollBar---------------------------------------------------------------}
  3722. { ScrollDraw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3723. {---------------------------------------------------------------------------}
  3724. PROCEDURE TScrollBar.ScrollDraw;
  3725. VAR P: PView;
  3726. BEGIN
  3727. If (Id <> 0) Then Begin
  3728. P := TopView; { Get topmost view }
  3729. NewMessage(P, evCommand, cmIdCommunicate, Id,
  3730. Value, @Self); { New Id style message }
  3731. End;
  3732. NewMessage(Owner, evBroadcast, cmScrollBarChanged,
  3733. Id, Value, @Self); { Old TV style message }
  3734. END;
  3735. {--TScrollBar---------------------------------------------------------------}
  3736. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3737. {---------------------------------------------------------------------------}
  3738. PROCEDURE TScrollBar.DrawBackGround;
  3739. VAR Bc: Byte;
  3740. BEGIN
  3741. If (GOptions AND goNativeClass = 0) Then Begin { Non natives draw }
  3742. Inherited DrawBackGround; { Call ancestor }
  3743. Bc := GetColor(1) AND $F0 SHR 4; { Background colour }
  3744. ClearArea(0, 0, FontWidth-1, FontHeight-1, Bc); { Clear top/left area }
  3745. BiColorRectangle(0, 0, FontWidth-1, FontHeight-1,
  3746. 15, 0, False); { Draw 3d effect }
  3747. ClearArea(RawSize.X-FontWidth+1, RawSize.Y-
  3748. FontHeight+1, RawSize.X, RawSize.Y, Bc); { Clr right/lower area }
  3749. BiColorRectangle(RawSize.X-FontWidth+1,
  3750. RawSize.Y-FontHeight+1,RawSize.X, RawSize.Y,
  3751. 15, 0, False); { Draw 3d effect }
  3752. End;
  3753. END;
  3754. {--TScrollBar---------------------------------------------------------------}
  3755. { SetValue -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
  3756. {---------------------------------------------------------------------------}
  3757. PROCEDURE TScrollBar.SetValue (AValue: Integer);
  3758. BEGIN
  3759. SetParams(AValue, Min, Max, PgStep, ArStep); { Set value }
  3760. END;
  3761. {--TScrollBar---------------------------------------------------------------}
  3762. { SetRange -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
  3763. {---------------------------------------------------------------------------}
  3764. PROCEDURE TScrollBar.SetRange (AMin, AMax: Integer);
  3765. BEGIN
  3766. SetParams(Value, AMin, AMax, PgStep, ArStep); { Set range }
  3767. END;
  3768. {--TScrollBar---------------------------------------------------------------}
  3769. { SetStep -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19May98 LdB }
  3770. {---------------------------------------------------------------------------}
  3771. PROCEDURE TScrollBar.SetStep (APgStep, AArStep: Integer);
  3772. BEGIN
  3773. SetParams(Value, Min, Max, APgStep, AArStep); { Set step sizes }
  3774. END;
  3775. {--TScrollBar---------------------------------------------------------------}
  3776. { SetParams -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 21Jul99 LdB }
  3777. {---------------------------------------------------------------------------}
  3778. PROCEDURE TScrollBar.SetParams (AValue, AMin, AMax, APgStep, AArStep: Integer);
  3779. BEGIN
  3780. If (AMax < AMin) Then AMax := AMin; { Max below min fix up }
  3781. If (AValue < AMin) Then AValue := AMin; { Value below min fix }
  3782. If (AValue > AMax) Then AValue := AMax; { Value above max fix }
  3783. If (Value <> AValue) OR (Min <> AMin) OR
  3784. (Max <> AMax) Then Begin { Something changed }
  3785. If (Min <> AMin) OR (Max <> AMax) Then Begin { Range has changed }
  3786. If (GOptions AND goNativeClass = 0) Then
  3787. ClearPos(GetPos); { Clear old position }
  3788. Min := AMin; { Set new minimum }
  3789. Max := AMax; { Set new maximum }
  3790. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  3791. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3792. (HWindow <> 0) Then
  3793. SetScrollRange(HWindow, sb_Ctl, Min, Max, { Set range }
  3794. AValue = Value); { Value=AValue redraws }
  3795. {$ENDIF}
  3796. {$IFDEF OS_OS2} { OS2 CODE }
  3797. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3798. (HWindow <> 0) AND ((Min <> 0) OR (Max <> 0))
  3799. Then Begin { Valid window }
  3800. WinSendMsg(HWindow, sbm_SetScrollBar, Value,
  3801. (LongInt(Max-1) SHL 16) OR Min); { Post the message }
  3802. End;
  3803. {$ENDIF}
  3804. { This was removed as found not needed but if you
  3805. change limits but value unchanged scrollbar is not redrawm..LdB }
  3806. {If (Value = AValue) AND (State and sfVisible <> 0)
  3807. Then ScrollDraw;} { Send message out }
  3808. End Else Begin
  3809. If (GOptions AND goNativeClass = 0) Then { Not in native mode }
  3810. ClearPos(GetPos); { Clear old position }
  3811. End;
  3812. If (Value <> AValue) Then Begin { Position moved }
  3813. Value := AValue; { Set new value }
  3814. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  3815. SetDrawMask(vdInner); { Set draw masks }
  3816. DrawView; { Redraw changed }
  3817. End;
  3818. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  3819. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3820. (HWindow <> 0) Then { Valid handle }
  3821. SetScrollPos(HWindow, sb_Ctl, Value, True); { Set scrollbar pos }
  3822. {$ENDIF}
  3823. {$IFDEF OS_OS2} { OS2 CODE }
  3824. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  3825. (HWindow <> 0) Then Begin { Valid window }
  3826. WinSendMsg(HWindow, sbm_SetPos, Value, 0); { Dispatch the message }
  3827. End;
  3828. {$ENDIF}
  3829. If (State AND sfVisible <> 0) Then ScrollDraw; { Send update message }
  3830. End;
  3831. End;
  3832. PgStep := APgStep; { Hold page step }
  3833. ArStep := AArStep; { Hold arrow step }
  3834. END;
  3835. {--TScrollBar---------------------------------------------------------------}
  3836. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3837. {---------------------------------------------------------------------------}
  3838. { You can save data to the stream compatable with the old original TV by }
  3839. { temporarily turning off the ofGrafVersion making the call to this store }
  3840. { routine and resetting the ofGrafVersion flag after the call. }
  3841. {---------------------------------------------------------------------------}
  3842. PROCEDURE TScrollBar.Store (Var S: TStream);
  3843. BEGIN
  3844. TView.Store(S); { TView.Store called }
  3845. S.Write(Value, 2); { Write current value }
  3846. S.Write(Min, 2); { Write min value }
  3847. S.Write(Max, 2); { Write max value }
  3848. S.Write(PgStep, 2); { Write page step size }
  3849. S.Write(ArStep, 2); { Write arrow step size }
  3850. S.Write(Chars, SizeOf(Chars)); { Write scroll chars }
  3851. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  3852. S.Write(Id, 2); { Write scrollbar id }
  3853. END;
  3854. {--TScrollBar---------------------------------------------------------------}
  3855. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22May98 LdB }
  3856. {---------------------------------------------------------------------------}
  3857. PROCEDURE TScrollBar.HandleEvent (Var Event: TEvent);
  3858. VAR Tracking: Boolean; I, P, S, ClickPart, Iv: Integer;
  3859. Mouse: TPoint; Extent: TRect;
  3860. FUNCTION GetPartCode: Integer;
  3861. VAR Mark, Part, J: Integer;
  3862. BEGIN
  3863. Part := -1; { Preset failure }
  3864. If Extent.Contains(Mouse) Then Begin { Contains mouse }
  3865. If (Size.X = 1) Then Begin { Vertical scrollbar }
  3866. Mark := Mouse.Y - FontHeight; { Calc position }
  3867. J := FontHeight; { Font height }
  3868. End Else Begin { Horizontal bar }
  3869. Mark := Mouse.X - FontWidth; { Calc position }
  3870. J := FontWidth; { Font width }
  3871. End;
  3872. If (Mark >= P) AND (Mark < P+J) Then { Within thumbnail }
  3873. Part := sbIndicator; { Indicator part }
  3874. If (Part <> sbIndicator) Then Begin { Not indicator part }
  3875. If (Mark < 1) Then Part := sbLeftArrow Else { Left arrow part }
  3876. If (Mark < P) Then Part := sbPageLeft Else { Page left part }
  3877. If (Mark < S) Then Part := sbPageRight Else { Page right part }
  3878. Part := sbRightArrow; { Right arrow part }
  3879. If (Size.X = 1) Then Inc(Part, 4); { Correct for vertical }
  3880. End;
  3881. End;
  3882. GetPartCode := Part; { Return part code }
  3883. END;
  3884. PROCEDURE Clicked;
  3885. BEGIN
  3886. NewMessage(Owner, evBroadcast, cmScrollBarClicked,
  3887. Id, Value, @Self); { Old TV style message }
  3888. END;
  3889. BEGIN
  3890. Inherited HandleEvent(Event); { Call ancestor }
  3891. Case Event.What Of
  3892. evNothing: Exit; { Speed up exit }
  3893. evCommand: Begin { Command event }
  3894. If (Event.Command = cmIdCommunicate) AND { Id communication }
  3895. (Event.Id = Id) AND (Event.InfoPtr <> @Self) { Targeted to us }
  3896. Then Begin
  3897. SetValue(Round(Event.Data)); { Set scrollbar value }
  3898. ClearEvent(Event); { Event was handled }
  3899. End;
  3900. End;
  3901. evKeyDown:
  3902. If (State AND sfVisible <> 0) Then Begin { Scrollbar visible }
  3903. ClickPart := sbIndicator; { Preset result }
  3904. If (Size.Y = 1) Then { Horizontal bar }
  3905. Case CtrlToArrow(Event.KeyCode) Of
  3906. kbLeft: ClickPart := sbLeftArrow; { Left one item }
  3907. kbRight: ClickPart := sbRightArrow; { Right one item }
  3908. kbCtrlLeft: ClickPart := sbPageLeft; { One page left }
  3909. kbCtrlRight: ClickPart := sbPageRight; { One page right }
  3910. kbHome: I := Min; { Move to start }
  3911. kbEnd: I := Max; { Move to end }
  3912. Else Exit; { Not a valid key }
  3913. End
  3914. Else { Vertical bar }
  3915. Case CtrlToArrow(Event.KeyCode) Of
  3916. kbUp: ClickPart := sbUpArrow; { One item up }
  3917. kbDown: ClickPart := sbDownArrow; { On item down }
  3918. kbPgUp: ClickPart := sbPageUp; { One page up }
  3919. kbPgDn: ClickPart := sbPageDown; { One page down }
  3920. kbCtrlPgUp: I := Min; { Move to top }
  3921. kbCtrlPgDn: I := Max; { Move to bottom }
  3922. Else Exit; { Not a valid key }
  3923. End;
  3924. Clicked; { Send out message }
  3925. If (ClickPart <> sbIndicator) Then
  3926. I := Value + ScrollStep(ClickPart); { Calculate position }
  3927. SetValue(I); { Set new item }
  3928. ClearEvent(Event); { Event now handled }
  3929. End;
  3930. evMouseDown: Begin { Mouse press event }
  3931. Clicked; { Scrollbar clicked }
  3932. Mouse.X := Event.Where.X - RawOrigin.X; { Localize x value }
  3933. Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value }
  3934. Extent.A.X := 0; { Zero x extent value }
  3935. Extent.A.Y := 0; { Zero y extent value }
  3936. Extent.B.X := RawSize.X; { Set extent x value }
  3937. Extent.B.Y := RawSize.Y; { set extent y value }
  3938. P := GetPos; { Current position }
  3939. S := GetSize; { Initial size }
  3940. ClickPart := GetPartCode; { Get part code }
  3941. If (ClickPart <> sbIndicator) Then Begin { Not thumb nail }
  3942. Repeat
  3943. Mouse.X := Event.Where.X-RawOrigin.X; { Localize x value }
  3944. Mouse.Y := Event.Where.Y-RawOrigin.Y; { Localize y value }
  3945. If GetPartCode = ClickPart Then
  3946. SetValue(Value+ScrollStep(ClickPart)); { Same part repeat }
  3947. Until NOT MouseEvent(Event, evMouseAuto); { Until auto done }
  3948. Clicked; { Scrollbar clicked }
  3949. End Else Begin { Thumb nail move }
  3950. Iv := Value; { Initial value }
  3951. Repeat
  3952. Mouse.X := Event.Where.X - RawOrigin.X; { Localize x value }
  3953. Mouse.Y := Event.Where.Y - RawOrigin.Y; { Localize y value }
  3954. Tracking := Extent.Contains(Mouse); { Check contains }
  3955. If Tracking Then Begin { Tracking mouse }
  3956. If (Size.X=1) Then
  3957. I := Mouse.Y-FontHeight Else { Calc vert position }
  3958. I := Mouse.X-FontWidth; { Calc horz position }
  3959. If (I < 0) Then I := 0; { Check underflow }
  3960. If (I > S) Then I := S; { Check overflow }
  3961. End Else I := GetPos; { Get position }
  3962. If (I <> P) Then Begin
  3963. SetValue(LongInt((LongInt(I)*(Max-Min))
  3964. +(S SHR 1)) DIV S + Min); { Set new value }
  3965. P := I; { Hold new position }
  3966. End;
  3967. Until NOT MouseEvent(Event, evMouseMove); { Until not moving }
  3968. If Tracking AND (S > 0) Then { Tracking mouse }
  3969. SetValue(LongInt((LongInt(P)*(Max-Min))+
  3970. (S SHR 1)) DIV S + Min); { Set new value }
  3971. If (Iv <> Value) Then Clicked; { Scroll has moved }
  3972. End;
  3973. ClearEvent(Event); { Clear the event }
  3974. End;
  3975. End;
  3976. END;
  3977. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  3978. {***************************************************************************}
  3979. { TScrollBar OBJECT WIN/NT/OS2 ONLY METHODS }
  3980. {***************************************************************************}
  3981. {--TScrollBar---------------------------------------------------------------}
  3982. { GetClassName -> Platforms WIN/NT/OS2 - Updated 21May98 LdB }
  3983. {---------------------------------------------------------------------------}
  3984. FUNCTION TScrollBar.GetClassName: String;
  3985. BEGIN
  3986. If UseNativeClasses Then Begin
  3987. GetClassName := TvScrollBarName; { Windows class name }
  3988. GOptions := GOptions OR goNativeClass; { Native class window }
  3989. End Else GetClassName := Inherited GetClassName; { Use standard class }
  3990. END;
  3991. {--TScrollBar---------------------------------------------------------------}
  3992. { GetClassAttr -> Platforms WIN/NT/OS2 - Updated 20May98 LdB }
  3993. {---------------------------------------------------------------------------}
  3994. FUNCTION TScrollBar.GetClassAttr: LongInt;
  3995. VAR Li: LongInt;
  3996. BEGIN
  3997. Li := Inherited GetClassAttr; { Call ancestor }
  3998. If UseNativeClasses Then Begin
  3999. If (Size.Y = 1) Then
  4000. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4001. Li := Li OR sbs_Horz OR sbs_TopAlign Else { Horizontal scrollbar }
  4002. Li := Li OR sbs_Vert OR sbs_LeftAlign; { Vertical scollbar }
  4003. {$ENDIF}
  4004. {$IFDEF OS_OS2} { OS2 CODE }
  4005. lStyle :=lStyle OR sbs_Horz OR sbs_AutoSize { Horizontal scrollbar }
  4006. Else lStyle := lStyle OR sbs_Vert OR
  4007. sbs_AutoSize; { Vertical scollbar }
  4008. {$ENDIF}
  4009. End;
  4010. GetClassAttr := Li; { Return attributes }
  4011. END;
  4012. {--TScrollBar---------------------------------------------------------------}
  4013. { CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 22May98 LdB }
  4014. {---------------------------------------------------------------------------}
  4015. PROCEDURE TScrollBar.CreateWindowNow (CmdShow: Integer);
  4016. {$IFDEF OS_OS2} VAR Mp1, Mp2: MParam; {$ENDIF}
  4017. BEGIN
  4018. Inherited CreateWindowNow(0); { Call inherited }
  4019. If (GOptions AND goNativeClass <> 0) AND { In native class mode }
  4020. (HWindow <> 0) AND ((Min <> 0) OR (Max <> 0))
  4021. Then Begin { Scrollbar created }
  4022. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4023. SetScrollRange(HWindow, sb_Ctl, Min,Max, True); { Set scrollbar range }
  4024. SetScrollPos(HWindow, sb_Ctl, Value, True); { Set scrollbar pos }
  4025. {$ENDIF}
  4026. {$IFDEF OS_OS2} { OS2 CODE }
  4027. WinSendMsg(HWindow, sbm_SetScrollBar, Value,
  4028. (LongInt(Max-1) SHL 16) OR Min); { Post the message }
  4029. {$ENDIF}
  4030. End;
  4031. END;
  4032. {$ENDIF}
  4033. {***************************************************************************}
  4034. { TScrollBar OBJECT PRIVATE METHODS }
  4035. {***************************************************************************}
  4036. {--TScrollBar---------------------------------------------------------------}
  4037. { GetPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB }
  4038. {---------------------------------------------------------------------------}
  4039. FUNCTION TScrollBar.GetPos: Integer;
  4040. VAR R: Integer;
  4041. BEGIN
  4042. R := Max - Min; { Get full range }
  4043. If (R = 0) Then GetPos := 0 Else { Return zero }
  4044. GetPos := LongInt((LongInt(Value-Min) * GetSize)
  4045. + (R SHR 1)) DIV R; { Calc position }
  4046. END;
  4047. {--TScrollBar---------------------------------------------------------------}
  4048. { GetSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23May98 LdB }
  4049. {---------------------------------------------------------------------------}
  4050. FUNCTION TScrollBar.GetSize: Integer;
  4051. VAR S: Integer;
  4052. BEGIN
  4053. If (Size.X = 1) Then S := RawSize.Y-3*FontHeight+1 { Vertical bar }
  4054. Else S := RawSize.X-3*FontWidth+1; { Horizontal bar }
  4055. If (S < 1) Then S := 1; { Fix minimum size }
  4056. GetSize := S; { Return size }
  4057. END;
  4058. {--TScrollBar---------------------------------------------------------------}
  4059. { DrawPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27OctMay99 LdB }
  4060. {---------------------------------------------------------------------------}
  4061. { This could be called from a message handling event so it must check the }
  4062. { view is visible, exposed and not obstructed before drawing the thumbnail }
  4063. { square area. }
  4064. {---------------------------------------------------------------------------}
  4065. PROCEDURE TScrollBar.DrawPos (Pos: Integer);
  4066. VAR X1, Y1, X2, Y2: Integer; ViewPort: ViewPortType;
  4067. BEGIN
  4068. If (State AND sfVisible <> 0) AND { View is visible }
  4069. (State AND sfExposed <> 0) AND { View is exposed }
  4070. (Max <> Min) Then Begin { View has some size }
  4071. SetViewLimits; { Set view limits }
  4072. GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
  4073. If OverlapsArea(ViewPort.X1, ViewPort.Y1,
  4074. ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
  4075. {$IFDEF OS_DOS}
  4076. HideMouseCursor; { Hide the mouse }
  4077. {$ENDIF}
  4078. X1 := 0; { Initial x position }
  4079. Y1 := 0; { Initial y position }
  4080. If (Size.X=1) Then Y1 := Pos + FontHeight { Vertical bar }
  4081. Else X1 := Pos + FontWidth; { Horizontal bar }
  4082. X2 := X1 + FontWidth - 1; { Right side point }
  4083. Y2 := Y1 + FontHeight - 1; { Lower side point }
  4084. ClearArea(X1, Y1, X2, Y2, GetColor(2) AND $0F);{ Thumbnail back }
  4085. BiColorRectangle(X1, Y1, X2, Y2, 15, 8, False);{ Draw highlight }
  4086. Y1 := (Y2 + Y1) DIV 2; { Middle of thumb }
  4087. Y2 := Y1+1; { One line down }
  4088. Inc(X1, 1); { One in off left }
  4089. Dec(X2, 1); { One in off right }
  4090. BiColorRectangle(X1, Y1, X2, Y2, 15, 8, True); { Draw line marker }
  4091. {$IFDEF OS_DOS}
  4092. ShowMouseCursor; { Show the mouse }
  4093. {$ENDIF}
  4094. End;
  4095. ReleaseViewLimits; { Release the limits }
  4096. End;
  4097. END;
  4098. {--TScrollBar---------------------------------------------------------------}
  4099. { ClearPos -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4100. {---------------------------------------------------------------------------}
  4101. { This could be called from a message handling event so it must check the }
  4102. { view is visible, exposed and not obstructed before clearing the old }
  4103. { thumbnail area. }
  4104. {---------------------------------------------------------------------------}
  4105. PROCEDURE TScrollBar.ClearPos (Pos: Integer);
  4106. VAR X, Y: Integer; ViewPort: ViewPortType;
  4107. BEGIN
  4108. If (State AND sfVisible <> 0) AND { View is visible }
  4109. (State AND sfExposed <> 0) Then Begin { View is exposed }
  4110. SetViewLimits; { Set view limits }
  4111. GetViewSettings(ViewPort, TextModeGFV); { Get set viewport }
  4112. If OverlapsArea(ViewPort.X1, ViewPort.Y1,
  4113. ViewPort.X2, ViewPort.Y2) Then Begin { Must be in area }
  4114. {$IFDEF OS_DOS}
  4115. HideMouseCursor; { Hide the mouse }
  4116. {$ENDIF}
  4117. X := 0; { Initial x position }
  4118. Y := 0; { Initial y position }
  4119. If (Size.X=1) Then Y := Pos + FontHeight { Vertical bar }
  4120. Else X := Pos + FontWidth; { Horizontal bar }
  4121. ClearArea(X, Y, X+FontWidth-1, Y+FontHeight-1,
  4122. GetColor(1) AND $F0 SHR 4); { Clear the area }
  4123. {$IFDEF OS_DOS}
  4124. ShowMouseCursor; { Show the mouse }
  4125. {$ENDIF}
  4126. End;
  4127. ReleaseViewLimits; { Release the limits }
  4128. End;
  4129. END;
  4130. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4131. { TScroller OBJECT METHODS }
  4132. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4133. {--TScroller----------------------------------------------------------------}
  4134. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4135. {---------------------------------------------------------------------------}
  4136. CONSTRUCTOR TScroller.Init (Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  4137. BEGIN
  4138. Inherited Init(Bounds); { Call ancestor }
  4139. Options := Options OR ofSelectable; { View is selectable }
  4140. EventMask := EventMask OR evBroadcast; { See broadcasts }
  4141. HScrollBar := AHScrollBar; { Hold horz scrollbar }
  4142. VScrollBar := AVScrollBar; { Hold vert scrollbar }
  4143. END;
  4144. {--TScroller----------------------------------------------------------------}
  4145. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4146. {---------------------------------------------------------------------------}
  4147. { This load method will read old original TV data from a stream as well }
  4148. { as the new graphical scroller views. }
  4149. {---------------------------------------------------------------------------}
  4150. CONSTRUCTOR TScroller.Load (Var S: TStream);
  4151. BEGIN
  4152. Inherited Load(S); { Call ancestor }
  4153. GetPeerViewPtr(S, HScrollBar); { Load horz scrollbar }
  4154. GetPeerViewPtr(S, VScrollBar); { Load vert scrollbar }
  4155. S.Read(Delta.X, 2); { Read delta x value }
  4156. S.Read(Delta.Y, 2); { Read delta y value }
  4157. S.Read(Limit.X, 2); { Read limit x value }
  4158. S.Read(Limit.Y, 2); { Read limit y value }
  4159. END;
  4160. {--TScroller----------------------------------------------------------------}
  4161. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4162. {---------------------------------------------------------------------------}
  4163. FUNCTION TScroller.GetPalette: PPalette;
  4164. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  4165. CONST P: String = CScroller; { Possible huge string }
  4166. {$ELSE} { OTHER COMPILERS }
  4167. CONST P: String[Length(CScroller)] = CScroller; { Always normal string }
  4168. {$ENDIF}
  4169. BEGIN
  4170. GetPalette := @P; { Scroller palette }
  4171. END;
  4172. {--TScroller----------------------------------------------------------------}
  4173. { ScrollTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4174. {---------------------------------------------------------------------------}
  4175. PROCEDURE TScroller.ScrollTo (X, Y: Integer);
  4176. BEGIN
  4177. Inc(DrawLock); { Set draw lock }
  4178. If (HScrollBar<>Nil) Then HScrollBar^.SetValue(X); { Set horz scrollbar }
  4179. If (VScrollBar<>Nil) Then VScrollBar^.SetValue(Y); { Set vert scrollbar }
  4180. Dec(DrawLock); { Release draw lock }
  4181. CheckDraw; { Check need to draw }
  4182. END;
  4183. {--TScroller----------------------------------------------------------------}
  4184. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4185. {---------------------------------------------------------------------------}
  4186. PROCEDURE TScroller.SetState (AState: Word; Enable: Boolean);
  4187. PROCEDURE ShowSBar (SBar: PScrollBar);
  4188. BEGIN
  4189. If (SBar <> Nil) Then { Scroll bar valid }
  4190. If GetState(sfActive + sfSelected) Then { Check state masks }
  4191. SBar^.Show Else SBar^.Hide; { Draw appropriately }
  4192. END;
  4193. BEGIN
  4194. Inherited SetState(AState, Enable); { Call ancestor }
  4195. If (AState AND (sfActive + sfSelected) <> 0) { Active/select change }
  4196. Then Begin
  4197. ShowSBar(HScrollBar); { Redraw horz scrollbar }
  4198. ShowSBar(VScrollBar); { Redraw vert scrollbar }
  4199. End;
  4200. END;
  4201. {--TScroller----------------------------------------------------------------}
  4202. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4203. {---------------------------------------------------------------------------}
  4204. { The scroller is saved to the stream compatable with the old TV object. }
  4205. {---------------------------------------------------------------------------}
  4206. PROCEDURE TScroller.Store (Var S: TStream);
  4207. BEGIN
  4208. TView.Store(S); { Call TView explicitly }
  4209. PutPeerViewPtr(S, HScrollBar); { Store horz bar }
  4210. PutPeerViewPtr(S, VScrollBar); { Store vert bar }
  4211. S.Write(Delta.X, 2); { Write delta x value }
  4212. S.Write(Delta.Y, 2); { Write delta y value }
  4213. S.Write(Limit.X, 2); { Write limit x value }
  4214. S.Write(Limit.Y, 2); { Write limit y value }
  4215. END;
  4216. {--TScroller----------------------------------------------------------------}
  4217. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4218. {---------------------------------------------------------------------------}
  4219. PROCEDURE TScroller.HandleEvent (Var Event: TEvent);
  4220. BEGIN
  4221. Inherited HandleEvent(Event); { Call ancestor }
  4222. If (Event.What = evBroadcast) AND
  4223. (Event.Command = cmScrollBarChanged) AND { Scroll bar change }
  4224. ((Event.InfoPtr = HScrollBar) OR { Our scrollbar? }
  4225. (Event.InfoPtr = VScrollBar)) Then ScrollDraw; { Redraw scroller }
  4226. END;
  4227. {--TScroller----------------------------------------------------------------}
  4228. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4229. {---------------------------------------------------------------------------}
  4230. PROCEDURE TScroller.ChangeBounds (Var Bounds: TRect);
  4231. BEGIN
  4232. SetBounds(Bounds); { Set new bounds }
  4233. Inc(DrawLock); { Set draw lock }
  4234. SetLimit(Limit.X, Limit.Y); { Adjust limits }
  4235. Dec(DrawLock); { Release draw lock }
  4236. DrawFlag := False; { Clear draw flag }
  4237. DrawView; { Redraw now }
  4238. END;
  4239. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4240. { TListViewer OBJECT METHODS }
  4241. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4242. CONST TvListViewerName = 'LISTBOX'; { Native name }
  4243. {--TListViewer--------------------------------------------------------------}
  4244. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4245. {---------------------------------------------------------------------------}
  4246. CONSTRUCTOR TListViewer.Init (Var Bounds: TRect; ANumCols: Word; AHScrollBar,
  4247. AVScrollBar: PScrollBar);
  4248. VAR ArStep, PgStep: Integer;
  4249. BEGIN
  4250. Inherited Init(Bounds); { Call ancestor }
  4251. Options := Options OR (ofFirstClick+ofSelectable); { Set options }
  4252. EventMask := EventMask OR evBroadcast; { Set event mask }
  4253. NumCols := ANumCols; { Hold column number }
  4254. If (AVScrollBar <> Nil) Then Begin { Chk vert scrollbar }
  4255. If (NumCols = 1) Then Begin { Only one column }
  4256. PgStep := Size.Y -1; { Set page size }
  4257. ArStep := 1; { Set step size }
  4258. End Else Begin { Multiple columns }
  4259. PgStep := Size.Y * NumCols; { Set page size }
  4260. ArStep := Size.Y; { Set step size }
  4261. End;
  4262. AVScrollBar^.SetStep(PgStep, ArStep); { Set scroll values }
  4263. End;
  4264. If (AHScrollBar <> Nil) Then
  4265. AHScrollBar^.SetStep(Size.X DIV NumCols, 1); { Set step size }
  4266. HScrollBar := AHScrollBar; { Horz scrollbar held }
  4267. VScrollBar := AVScrollBar; { Vert scrollbar held }
  4268. GOptions := GOptions OR goDrawFocus; { Draw focus changes }
  4269. END;
  4270. {--TListViewer--------------------------------------------------------------}
  4271. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4272. {---------------------------------------------------------------------------}
  4273. CONSTRUCTOR TListViewer.Load (Var S: TStream);
  4274. BEGIN
  4275. Inherited Load(S); { Call ancestor }
  4276. GetPeerViewPtr(S, HScrollBar); { Get horz scrollbar }
  4277. GetPeerViewPtr(S, VScrollBar); { Get vert scrollbar }
  4278. S.Read(NumCols, 2); { Read column number }
  4279. S.Read(TopItem, 2); { Read top most item }
  4280. S.Read(Focused, 2); { Read focused item }
  4281. S.Read(Range, 2); { Read listview range }
  4282. END;
  4283. {--TListViewer--------------------------------------------------------------}
  4284. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4285. {---------------------------------------------------------------------------}
  4286. FUNCTION TListViewer.GetPalette: PPalette;
  4287. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  4288. CONST P: String = CListViewer; { Possible huge string }
  4289. {$ELSE} { OTHER COMPILERS }
  4290. CONST P: String[Length(CListViewer)] = CListViewer; { Always normal string }
  4291. {$ENDIF}
  4292. BEGIN
  4293. GetPalette := @P; { Return palette }
  4294. END;
  4295. {--TListViewer--------------------------------------------------------------}
  4296. { IsSelected -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4297. {---------------------------------------------------------------------------}
  4298. FUNCTION TListViewer.IsSelected (Item: Integer): Boolean;
  4299. BEGIN
  4300. If (Item = Focused) Then IsSelected := True Else
  4301. IsSelected := False; { Selected item }
  4302. END;
  4303. {--TListViewer--------------------------------------------------------------}
  4304. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  4305. {---------------------------------------------------------------------------}
  4306. FUNCTION TListViewer.GetText (Item: Integer; MaxLen: Integer): String;
  4307. BEGIN { Abstract method }
  4308. GetText := ''; { Return empty }
  4309. END;
  4310. {--TListViewer--------------------------------------------------------------}
  4311. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4312. {---------------------------------------------------------------------------}
  4313. PROCEDURE TListViewer.DrawBackGround;
  4314. VAR I, J, ColWidth, Item, Indent, CurCol: Integer; Color: Word;
  4315. Text: String; B: TDrawBuffer;
  4316. {$IFDEF OS_WINDOWS} S: String; {$ENDIF} { WIN/NT CODE }
  4317. BEGIN
  4318. ColWidth := Size.X DIV NumCols + 1; { Calc column width }
  4319. If (HScrollBar = Nil) Then Indent := 0 Else { Set indent to zero }
  4320. Indent := HScrollBar^.Value; { Fetch any indent }
  4321. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4322. If (GOptions AND goNativeClass <> 0) Then Begin { Native class mode }
  4323. If (Range <> SendMessage(HWindow, lb_GetCount,
  4324. 0, 0)) Then SendMessage(HWindow,lb_ResetContent, { If ranges differ }
  4325. 0, 0); { Clear all strings }
  4326. For I := 1 To Range Do Begin { For each item }
  4327. J := SendMessage(HWindow, lb_GetText, 0,
  4328. LongInt(@S[1])); { Get current text }
  4329. If (J <> lb_Err) Then Begin { Check for error }
  4330. {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
  4331. SetLength(S, J); { Set string length }
  4332. {$ELSE} { OTHER COMPILERS }
  4333. S[0] := Chr(J); { Set string legth }
  4334. {$ENDIF}
  4335. End Else S := ''; { Error no string }
  4336. Text := GetText(I-1, ColWidth + Indent); { Fetch text }
  4337. Text := Copy(Text, Indent, ColWidth) + #0; { Select right bit }
  4338. If (S <> Text) Then Begin { Strings differ }
  4339. If (J <> lb_Err) Then SendMessage(HWindow,
  4340. lb_DeleteString, I-1, 0); { Delete current string }
  4341. SendMessage(HWindow, lb_InsertString, I-1,
  4342. LongInt(@Text[1])); { Set string in list }
  4343. End;
  4344. End;
  4345. If (Options AND ofSelectable <> 0) Then
  4346. SendMessage(HWindow, lb_SetCurSel, Focused, 0); { Focus selected item }
  4347. TopItem := SendMessage(HWindow, lb_GetTopIndex,
  4348. 0, 0); { Synchronize }
  4349. UpdateWindow(HWindow); { Redraw new strings }
  4350. Exit; { Native mode is done }
  4351. End;
  4352. {$ENDIF}
  4353. Inherited DrawBackGround; { Call ancestor }
  4354. Color := GetColor(2); { Normal colour }
  4355. For I := 0 To Size.Y - 1 Do Begin { For each line }
  4356. For J := 0 To NumCols-1 Do Begin { For each column }
  4357. Item := J*Size.Y + I + TopItem; { Process this item }
  4358. CurCol := J*ColWidth; { Current column }
  4359. MoveChar(B[CurCol], ' ', Color, ColWidth); { Clear buffer }
  4360. If (Item < Range) Then Begin { Within text range }
  4361. Text := GetText(Item, ColWidth + Indent); { Fetch text }
  4362. Text := Copy(Text, Indent, ColWidth); { Select right bit }
  4363. MoveStr(B[CurCol+1], Text, Color); { Transfer to buffer }
  4364. If ShowMarkers Then Begin
  4365. WordRec(B[CurCol]).Lo := Byte(
  4366. SpecialChars[4]); { Set marker character }
  4367. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(
  4368. SpecialChars[5]); { Set marker character }
  4369. End;
  4370. End;
  4371. MoveChar(B[CurCol+ColWidth-1], #179,
  4372. GetColor(5), 1); { Put centre line marker }
  4373. End;
  4374. WriteLine(0, I, Size.X, 1, B); { Write line to screen }
  4375. End;
  4376. END;
  4377. {--TListViewer--------------------------------------------------------------}
  4378. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4379. {---------------------------------------------------------------------------}
  4380. PROCEDURE TListViewer.DrawFocus;
  4381. VAR DrawIt: Boolean; SCOff: Byte; I, J, Item, CurCol, ColWidth: Integer;
  4382. Color: Word;
  4383. Indent: Integer;
  4384. B: TDrawBuffer;
  4385. Text: String;
  4386. BEGIN
  4387. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4388. If (GOptions AND goNativeClass <> 0) Then Exit; { Native class exits }
  4389. {$ENDIF}
  4390. ColWidth := Size.X DIV NumCols + 1; { Calc column width }
  4391. If (HScrollBar = Nil) Then Indent := 0 Else { Set indent to zero }
  4392. Indent := HScrollBar^.Value; { Fetch any indent }
  4393. For I := 0 To Size.Y - 1 Do Begin { For each line }
  4394. For J := 0 To NumCols-1 Do Begin { For each column }
  4395. Item := J*Size.Y + I + TopItem; { Process this item }
  4396. CurCol := J*ColWidth; { Current column }
  4397. DrawIt := False; { Preset false }
  4398. If (State AND (sfSelected + sfActive) =
  4399. (sfSelected + sfActive)) AND (Focused = Item) { Focused item }
  4400. AND (Range > 0) Then Begin
  4401. DrawIt := True; { Draw this item }
  4402. Color := GetColor(3); { Focused colour }
  4403. SetCursor(CurCol+1,I); { Set the cursor }
  4404. SCOff := 0; { Zero colour offset }
  4405. End Else If (Item < Range) AND IsSelected(Item){ Selected item }
  4406. Then Begin
  4407. DrawIt := True; { Draw this item }
  4408. If (State AND sfActive <> 0) Then
  4409. Color := GetColor(4) Else { Selected colour }
  4410. Color := GetColor(2); { Remove focus }
  4411. SCOff := 2; { Colour offset=2 }
  4412. End;
  4413. If DrawIt Then Begin { We are drawing item }
  4414. ClearArea(0, I*FontHeight, ColWidth*FontWidth,
  4415. (I+1)*FontHeight-1, Color AND $F0 SHR 4); { Draw the bar }
  4416. MoveChar(B[CurCol], ' ', Color, ColWidth);
  4417. if Item < Range then begin
  4418. Text := GetText(Item, ColWidth + Indent);
  4419. Text := Copy(Text,Indent,ColWidth);
  4420. MoveStr(B[CurCol+1], Text, Color);
  4421. if ShowMarkers then begin
  4422. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  4423. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  4424. end;
  4425. end;
  4426. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  4427. WriteLine(0, I, Size.X, 1, B);
  4428. End;
  4429. End;
  4430. End;
  4431. END;
  4432. {--TListViewer--------------------------------------------------------------}
  4433. { FocusItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4434. {---------------------------------------------------------------------------}
  4435. PROCEDURE TListViewer.FocusItem (Item: Integer);
  4436. BEGIN
  4437. Focused := Item; { Set focus to item }
  4438. If (VScrollBar <> Nil) Then
  4439. VScrollBar^.SetValue(Item); { Scrollbar to value }
  4440. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4441. If (GOptions AND goNativeClass <> 0) Then Begin { Native class mode }
  4442. If (HWindow <> 0) Then Begin { Check window valid }
  4443. If (Options AND ofSelectable <> 0) Then
  4444. SendMessage(HWindow, lb_SetCurSel, Focused, 0);{ Focus selected item }
  4445. TopItem := SendMessage(HWindow, lb_GetTopIndex,
  4446. 0, 0); { Synchronize }
  4447. End;
  4448. Exit; { Native mode done }
  4449. End;
  4450. {$ENDIF}
  4451. If (Item < TopItem) Then { Item above top item }
  4452. If (NumCols = 1) Then TopItem := Item { Set top item }
  4453. Else TopItem := Item - Item MOD Size.Y { Set top item }
  4454. Else If (Item >= TopItem + (Size.Y*NumCols)) Then { Item below bottom }
  4455. If (NumCols = 1) Then TopItem := Item-Size.Y+1 { Set new top item }
  4456. Else TopItem := Item - Item MOD Size.Y -
  4457. (Size.Y*(NumCols-1)); { Set new top item }
  4458. END;
  4459. {--TListViewer--------------------------------------------------------------}
  4460. { SetTopItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Aug99 LdB }
  4461. {---------------------------------------------------------------------------}
  4462. PROCEDURE TListViewer.SetTopItem (Item: Integer);
  4463. BEGIN
  4464. TopItem := Item; { Set the top item }
  4465. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4466. If (GOptions AND goNativeClass <> 0) AND { Native class mode }
  4467. (HWindow <> 0) Then { Window valid }
  4468. SendMessage(HWindow, lb_SetTopIndex, Item, 0); { Synchronize }
  4469. {$ENDIF}
  4470. END;
  4471. {--TListViewer--------------------------------------------------------------}
  4472. { SetRange -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4473. {---------------------------------------------------------------------------}
  4474. PROCEDURE TListViewer.SetRange (ARange: Integer);
  4475. BEGIN
  4476. Range := ARange; { Set new range }
  4477. If (VScrollBar <> Nil) Then Begin { Vertical scrollbar }
  4478. If (Focused > ARange) Then Focused := 0; { Clear focused }
  4479. VScrollBar^.SetParams(Focused, 0, ARange - 1,
  4480. VScrollBar^.PgStep, VScrollBar^.ArStep); { Set parameters }
  4481. End;
  4482. END;
  4483. {--TListViewer--------------------------------------------------------------}
  4484. { SelectItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4485. {---------------------------------------------------------------------------}
  4486. PROCEDURE TListViewer.SelectItem (Item: Integer);
  4487. BEGIN
  4488. Message(Owner, evBroadcast, cmListItemSelected,
  4489. @Self); { Send message }
  4490. END;
  4491. {--TListViewer--------------------------------------------------------------}
  4492. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4493. {---------------------------------------------------------------------------}
  4494. PROCEDURE TListViewer.SetState (AState: Word; Enable: Boolean);
  4495. PROCEDURE ShowSBar(SBar: PScrollBar);
  4496. BEGIN
  4497. If (SBar <> Nil) Then { Valid scrollbar }
  4498. If GetState(sfActive) AND GetState(sfVisible) { Check states }
  4499. Then SBar^.Show Else SBar^.Hide; { Show or hide }
  4500. END;
  4501. PROCEDURE LoseFocus;
  4502. VAR Cs: Integer;
  4503. BEGIN
  4504. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  4505. Cs := State; { Hold current state }
  4506. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  4507. State := State AND (sfActive XOR $FFFF); { Weird bug!!! }
  4508. {$ELSE} { OTHER COMPILERS }
  4509. State := State AND NOT sfActive; { Must remove focus }
  4510. {$ENDIF}
  4511. SetDrawmask(vdFocus); { Set focus mask }
  4512. DrawView; { Remove focus box }
  4513. State := Cs; { Reset state masks }
  4514. End;
  4515. END;
  4516. BEGIN
  4517. Inherited SetState(AState, Enable); { Call ancestor }
  4518. If (AState AND sfFocused <> 0) Then { Focus change }
  4519. If NOT Enable Then LoseFocus; { Redraw drop focus }
  4520. If (AState AND (sfSelected + sfActive + sfVisible) <> 0)
  4521. Then Begin { Check states }
  4522. SetDrawMask(vdFocus);
  4523. DrawView; { Draw the view }
  4524. ShowSBar(HScrollBar); { Show horz scrollbar }
  4525. ShowSBar(VScrollBar); { Show vert scrollbar }
  4526. End;
  4527. END;
  4528. {--TListViewer--------------------------------------------------------------}
  4529. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4530. {---------------------------------------------------------------------------}
  4531. PROCEDURE TListViewer.Store (Var S: TStream);
  4532. BEGIN
  4533. TView.Store(S); { Call TView explicitly }
  4534. PutPeerViewPtr(S, HScrollBar); { Put horz scrollbar }
  4535. PutPeerViewPtr(S, VScrollBar); { Put vert scrollbar }
  4536. S.Write(NumCols, 2); { Write column number }
  4537. S.Write(TopItem, 2); { Write top most item }
  4538. S.Write(Focused, 2); { Write focused item }
  4539. S.Write(Range, 2); { Write listview range }
  4540. END;
  4541. {--TListViewer--------------------------------------------------------------}
  4542. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 27Oct99 LdB }
  4543. {---------------------------------------------------------------------------}
  4544. PROCEDURE TListViewer.HandleEvent (Var Event: TEvent);
  4545. CONST MouseAutosToSkip = 4;
  4546. VAR Oi, Ni: Integer; Ct, Cw: Word; Mouse: TPoint;
  4547. PROCEDURE MoveFocus (Req: Integer);
  4548. VAR Ti, Cs: Integer;
  4549. BEGIN
  4550. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  4551. Ti := TopItem; { Hold top item }
  4552. Cs := State; { Hold current state }
  4553. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  4554. State := State AND (sfActive XOR $FFFF); { Weird bug!!!! }
  4555. {$ELSE} { OTHER COMPILERS }
  4556. State := State AND NOT sfActive; { Must remove focus }
  4557. {$ENDIF}
  4558. SetDrawmask(vdFocus); { Set focus mask }
  4559. DrawView; { Remove focus box }
  4560. State := Cs; { Reset state masks }
  4561. End;
  4562. FocusItemNum(Req); { Focus req item }
  4563. If (GOptions AND goNativeClass = 0) Then Begin { Not in native mode }
  4564. If (Ti <> TopItem) Then DrawView Else Begin { Redraw all view }
  4565. SetDrawmask(vdFocus); { Set focus mask }
  4566. DrawView; { Redraw focus box }
  4567. End;
  4568. End;
  4569. END;
  4570. BEGIN
  4571. Inherited HandleEvent(Event); { Call ancestor }
  4572. Case Event.What Of
  4573. evNothing: Exit; { Speed up exit }
  4574. evKeyDown: Begin { Key down event }
  4575. If (Event.CharCode = ' ') AND (Focused < Range){ Spacebar select }
  4576. Then Begin
  4577. SelectItem(Focused); { Select focused item }
  4578. Ni := Focused; { Hold new item }
  4579. End Else Case CtrlToArrow(Event.KeyCode) Of
  4580. kbUp: Ni := Focused - 1; { One item up }
  4581. kbDown: Ni := Focused + 1; { One item down }
  4582. kbRight: If (NumCols > 1) Then
  4583. Ni := Focused + Size.Y Else Exit; { One column right }
  4584. kbLeft: If (NumCols > 1) Then
  4585. Ni := Focused - Size.Y Else Exit; { One column left }
  4586. kbPgDn: Ni := Focused + Size.Y * NumCols; { One page down }
  4587. kbPgUp: Ni := Focused - Size.Y * NumCols; { One page up }
  4588. kbHome: Ni := TopItem; { Move to top }
  4589. kbEnd: Ni := TopItem + (Size.Y*NumCols)-1; { Move to bottom }
  4590. kbCtrlPgDn: Ni := Range - 1; { Move to last item }
  4591. kbCtrlPgUp: Ni := 0; { Move to first item }
  4592. Else Exit;
  4593. End;
  4594. MoveFocus(Ni); { Move the focus }
  4595. ClearEvent(Event); { Event was handled }
  4596. End;
  4597. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4598. evCommand: If (Event.Command = cmNotify) Then { Notify command }
  4599. Begin
  4600. FocusItem(Round(Event.Data)); { Focus the item }
  4601. SelectItem(Focused); { Select the item }
  4602. ClearEvent(Event); { Event was handled }
  4603. End Else Exit; { Not handled command }
  4604. {$ENDIF}
  4605. evBroadcast: Begin { Broadcast event }
  4606. If (Options AND ofSelectable <> 0) Then { View is selectable }
  4607. If (Event.Command = cmScrollBarClicked) AND { Scrollbar click }
  4608. ((Event.InfoPtr = HScrollBar) OR
  4609. (Event.InfoPtr = VScrollBar)) Then Select { Scrollbar selects us }
  4610. Else If (Event.Command = cmScrollBarChanged) { Scrollbar changed }
  4611. Then Begin
  4612. If (VScrollBar = Event.InfoPtr) Then Begin
  4613. MoveFocus(VScrollBar^.Value); { Focus us to item }
  4614. End Else If (HScrollBar = Event.InfoPtr)
  4615. Then DrawView; { Redraw the view }
  4616. End;
  4617. End;
  4618. evMouseDown: Begin { Mouse down event }
  4619. Cw := Size.X DIV NumCols + 1; { Column width }
  4620. Oi := Focused; { Hold focused item }
  4621. MakeLocal(Event.Where, Mouse); { Localize mouse }
  4622. If MouseInView(Event.Where) Then Ni := Mouse.Y
  4623. + (Size.Y*(Mouse.X DIV Cw))+TopItem { Calc item to focus }
  4624. Else Ni := Oi; { Focus old item }
  4625. Ct := 0; { Clear count value }
  4626. Repeat
  4627. If (Ni <> Oi) Then Begin { Item is different }
  4628. MoveFocus(Ni); { Move the focus }
  4629. Oi := Focused; { Hold as focused item }
  4630. End;
  4631. MakeLocal(Event.Where, Mouse); { Localize mouse }
  4632. If NOT MouseInView(Event.Where) Then Begin
  4633. If (Event.What = evMouseAuto) Then Inc(Ct);{ Inc auto count }
  4634. If (Ct = MouseAutosToSkip) Then Begin
  4635. Ct := 0; { Reset count }
  4636. If (NumCols = 1) Then Begin { Only one column }
  4637. If (Mouse.Y < 0) Then Ni := Focused-1; { Move up one item }
  4638. If (Mouse.Y >= Size.Y) Then
  4639. Ni := Focused+1; { Move down one item }
  4640. End Else Begin { Multiple columns }
  4641. If (Mouse.X < 0) Then { Mouse x below zero }
  4642. Ni := Focused-Size.Y; { Move down 1 column }
  4643. If (Mouse.X >= Size.X) Then { Mouse x above width }
  4644. Ni := Focused+Size.Y; { Move up 1 column }
  4645. If (Mouse.Y < 0) Then { Mouse y below zero }
  4646. Ni := Focused-Focused MOD Size.Y; { Move up one item }
  4647. If (Mouse.Y > Size.Y) Then { Mouse y above height }
  4648. Ni := Focused-Focused MOD
  4649. Size.Y+Size.Y-1; { Move down one item }
  4650. End;
  4651. End;
  4652. End Else Ni := Mouse.Y + (Size.Y*(Mouse.X
  4653. DIV Cw))+TopItem; { New item to focus }
  4654. Until NOT MouseEvent(Event, evMouseMove +
  4655. evMouseAuto); { Mouse stopped }
  4656. If (Oi <> Ni) Then MoveFocus(Ni); { Focus moved again }
  4657. If (Event.Double AND (Range > Focused)) Then
  4658. SelectItem(Focused); { Select the item }
  4659. ClearEvent(Event); { Event was handled }
  4660. End;
  4661. End;
  4662. END;
  4663. {--TListViewer--------------------------------------------------------------}
  4664. { ChangeBounds -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4665. {---------------------------------------------------------------------------}
  4666. PROCEDURE TListViewer.ChangeBounds (Var Bounds: TRect);
  4667. BEGIN
  4668. Inherited ChangeBounds(Bounds); { Call ancestor }
  4669. If (HScrollBar <> Nil) Then { Valid horz scrollbar }
  4670. HScrollBar^.SetStep(Size.X DIV NumCols,
  4671. HScrollBar^.ArStep); { Update horz bar }
  4672. If (VScrollBar <> Nil) Then { Valid vert scrollbar }
  4673. VScrollBar^.SetStep(Size.Y * NumCols,
  4674. VScrollBar^.ArStep); { Update vert bar }
  4675. END;
  4676. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4677. {***************************************************************************}
  4678. { TListViewer OBJECT WIN/NT ONLY METHODS }
  4679. {***************************************************************************}
  4680. {--TListViewer--------------------------------------------------------------}
  4681. { GetNotifyCmd -> Platforms WIN/NT/OS2 - Updated 06Aug99 LdB }
  4682. {---------------------------------------------------------------------------}
  4683. FUNCTION TListViewer.GetNotifyCmd: LongInt;
  4684. BEGIN
  4685. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  4686. GetNotifyCmd := lb_GetCurSel; { Listbox get selection }
  4687. {$ENDIF}
  4688. {$IFDEF OS_OS2} { OS2 CODE }
  4689. GetNotifyCmd := lm_QuerySelection; { Listbox get selection }
  4690. {$ENDIF}
  4691. END;
  4692. {--TListViewer--------------------------------------------------------------}
  4693. { GetClassName -> Platforms WIN/NT - Updated 27Oct99 LdB }
  4694. {---------------------------------------------------------------------------}
  4695. FUNCTION TListViewer.GetClassName: String;
  4696. BEGIN
  4697. If UseNativeClasses Then Begin { Use native classes }
  4698. GetClassName := TvListViewerName; { Windows class name }
  4699. GOptions := GOptions OR goNativeClass; { Native class window }
  4700. End Else GetClassName := Inherited GetClassName; { Use standard class }
  4701. END;
  4702. {--TListViewer--------------------------------------------------------------}
  4703. { GetClassAttr -> Platforms WIN/NT - Updated 27Oct99 LdB }
  4704. {---------------------------------------------------------------------------}
  4705. FUNCTION TListViewer.GetClassAttr: LongInt;
  4706. VAR Li: LongInt;
  4707. BEGIN
  4708. Li := Inherited GetClassAttr; { Call ancestor }
  4709. Li := Li OR lbs_HasStrings OR lbs_Notify; { Set has strings mask }
  4710. If (NumCols > 1) Then
  4711. Li := Li OR lbs_MultiColumn; { Has multiple columns }
  4712. Li := Li OR LBS_NOINTEGRALHEIGHT ;
  4713. GetClassAttr := Li; { Return attributes }
  4714. END;
  4715. {--TListViewer--------------------------------------------------------------}
  4716. { CreateWindowNow -> Platforms WIN/NT - Updated 27Oct99 LdB }
  4717. {---------------------------------------------------------------------------}
  4718. PROCEDURE TListViewer.CreateWindowNow (CmdShow: Integer);
  4719. BEGIN
  4720. Inherited CreateWindowNow(CmdShow); { Call ancestor }
  4721. DrawView; { Redraw the view }
  4722. END;
  4723. {$ENDIF}
  4724. {***************************************************************************}
  4725. { TListViewer OBJECT PRIVATE METHODS }
  4726. {***************************************************************************}
  4727. {--TListViewer--------------------------------------------------------------}
  4728. { FocusItemNum -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  4729. {---------------------------------------------------------------------------}
  4730. PROCEDURE TListViewer.FocusItemNum (Item: Integer);
  4731. BEGIN
  4732. If (Item < 0) Then Item := 0 Else { Restrain underflow }
  4733. If (Item >= Range) AND (Range > 0) Then
  4734. Item := Range-1; { Restrain overflow }
  4735. If (Range <> 0) Then FocusItem(Item); { Set focus value }
  4736. END;
  4737. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4738. { TWindow OBJECT METHODS }
  4739. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  4740. {--TWindow------------------------------------------------------------------}
  4741. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4742. {---------------------------------------------------------------------------}
  4743. CONSTRUCTOR TWindow.Init (Var Bounds: TRect; ATitle: TTitleStr; ANumber: Integer);
  4744. BEGIN
  4745. Inherited Init(Bounds); { Call ancestor }
  4746. State := State OR sfShadow; { View is shadowed }
  4747. Options := Options OR (ofSelectable+ofTopSelect); { Select options set }
  4748. GrowMode := gfGrowAll + gfGrowRel; { Set growmodes }
  4749. Flags := wfMove + wfGrow + wfClose + wfZoom; { Set flags }
  4750. Title := NewStr(ATitle); { Hold title }
  4751. Number := ANumber; { Hold number }
  4752. Palette := wpBlueWindow; { Default palette }
  4753. GOptions := GOptions OR goThickFramed; { Thick frame }
  4754. GOptions := GOptions OR goTitled; { Title window }
  4755. GOptions := GOptions AND NOT goNoDrawView; { View does draw self }
  4756. InitFrame; { Initialize frame }
  4757. If (Frame <> Nil) Then Insert(Frame); { Insert any frame }
  4758. GetBounds(ZoomRect); { Default zoom rect }
  4759. END;
  4760. {--TWindow------------------------------------------------------------------}
  4761. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  4762. {---------------------------------------------------------------------------}
  4763. { This load method will read old original TV data from a stream however }
  4764. { although a frame view is read for compatability it is disposed of. }
  4765. {---------------------------------------------------------------------------}
  4766. CONSTRUCTOR TWindow.Load (Var S: TStream);
  4767. BEGIN
  4768. Inherited Load(S); { Call ancestor }
  4769. S.Read(Flags, 1); { Read window flags }
  4770. S.Read(Number, 2); { Read window number }
  4771. S.Read(Palette, 2); { Read window palette }
  4772. S.Read(ZoomRect.A.X, 2); { Read zoom area x1 }
  4773. S.Read(ZoomRect.A.Y, 2); { Read zoom area y1 }
  4774. S.Read(ZoomRect.B.X, 2); { Read zoom area x2 }
  4775. S.Read(ZoomRect.B.Y, 2); { Read zoom area y2 }
  4776. GetSubViewPtr(S, Frame); { Now read frame object }
  4777. If (Frame <> Nil) Then Begin
  4778. Dispose(Frame, Done); { Kill we don't use it }
  4779. Frame := Nil; { Clear the pointer }
  4780. End;
  4781. Title := S.ReadStr; { Read title }
  4782. END;
  4783. {--TWindow------------------------------------------------------------------}
  4784. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4785. {---------------------------------------------------------------------------}
  4786. DESTRUCTOR TWindow.Done;
  4787. BEGIN
  4788. Inherited Done; { Call ancestor }
  4789. If (Title <> Nil) Then DisposeStr(Title); { Dispose title }
  4790. END;
  4791. {--TWindow------------------------------------------------------------------}
  4792. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4793. {---------------------------------------------------------------------------}
  4794. FUNCTION TWindow.GetPalette: PPalette;
  4795. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  4796. CONST P: ARRAY [wpBlueWindow..wpGrayWindow] Of String =
  4797. (CBlueWindow, CCyanWindow, CGrayWindow); { Possible huge string }
  4798. {$ELSE} { OTHER COMPILERS }
  4799. CONST P: ARRAY [wpBlueWindow..wpGrayWindow] Of String[Length(CBlueWindow)] =
  4800. (CBlueWindow, CCyanWindow, CGrayWindow); { Always normal string }
  4801. {$ENDIF}
  4802. BEGIN
  4803. GetPalette := @P[Palette]; { Return palette }
  4804. END;
  4805. {--TWindow------------------------------------------------------------------}
  4806. { GetTitle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4807. {---------------------------------------------------------------------------}
  4808. FUNCTION TWindow.GetTitle (MaxSize: Integer): TTitleStr;
  4809. VAR S: String;
  4810. BEGIN
  4811. If (Number <> 0) Then begin { Valid window number }
  4812. Str(Number, S); { Window number }
  4813. S := '(' + S + ') '; { Insert in brackets }
  4814. End Else S := ''; { Empty string }
  4815. If (Title <> Nil) Then GetTitle := S + Title^
  4816. Else GetTitle := S; { Return title }
  4817. END;
  4818. {--TWindow------------------------------------------------------------------}
  4819. { StandardScrollBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  4820. {---------------------------------------------------------------------------}
  4821. FUNCTION TWindow.StandardScrollBar (AOptions: Word): PScrollBar;
  4822. VAR R: TRect; S: PScrollBar;
  4823. BEGIN
  4824. GetExtent(R); { View extents }
  4825. If (AOptions AND sbVertical = 0) Then
  4826. R.Assign(R.A.X+2, R.B.Y-1, R.B.X-2, R.B.Y) { Horizontal scrollbar }
  4827. Else R.Assign(R.B.X-1, R.A.Y+1, R.B.X, R.B.Y-1); { Vertical scrollbar }
  4828. S := New(PScrollBar, Init(R)); { Create scrollbar }
  4829. Insert(S); { Insert scrollbar }
  4830. If (AOptions AND sbHandleKeyboard <> 0) Then
  4831. S^.Options := S^.Options or ofPostProcess; { Post process }
  4832. StandardScrollBar := S; { Return scrollbar }
  4833. END;
  4834. {--TWindow------------------------------------------------------------------}
  4835. { Zoom -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep97 LdB }
  4836. {---------------------------------------------------------------------------}
  4837. PROCEDURE TWindow.Zoom;
  4838. VAR R: TRect; Max, Min: TPoint;
  4839. BEGIN
  4840. SizeLimits(Min, Max); { Return size limits }
  4841. If ((Size.X <> Max.X) OR (Size.Y <> Max.Y)) { Larger size possible }
  4842. Then Begin
  4843. GetBounds(ZoomRect); { Get zoom bounds }
  4844. R.A.X := 0; { Zero x origin }
  4845. R.A.Y := 0; { Zero y origin }
  4846. R.B := Max; { Bounds to max size }
  4847. Locate(R); { Locate the view }
  4848. End Else Locate(ZoomRect); { Move to zoom rect }
  4849. END;
  4850. {--TWindow------------------------------------------------------------------}
  4851. { Close -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep97 LdB }
  4852. {---------------------------------------------------------------------------}
  4853. PROCEDURE TWindow.Close;
  4854. BEGIN
  4855. If Valid(cmClose) Then Free; { Dispose of self }
  4856. END;
  4857. {--TWindow------------------------------------------------------------------}
  4858. { InitFrame -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Jul99 LdB }
  4859. {---------------------------------------------------------------------------}
  4860. PROCEDURE TWindow.InitFrame;
  4861. BEGIN { Compatability only }
  4862. END;
  4863. {--TWindow------------------------------------------------------------------}
  4864. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB }
  4865. {---------------------------------------------------------------------------}
  4866. PROCEDURE TWindow.SetState (AState: Word; Enable: Boolean);
  4867. VAR WindowCommands: TCommandSet;
  4868. BEGIN
  4869. Inherited SetState(AState, Enable); { Call ancestor }
  4870. If (AState = sfSelected) Then
  4871. SetState(sfActive, Enable); { Set active state }
  4872. If (AState = sfSelected) OR ((AState = sfExposed)
  4873. AND (State AND sfSelected <> 0)) Then Begin { View is selected }
  4874. WindowCommands := [cmNext, cmPrev]; { Set window commands }
  4875. If (Flags AND (wfGrow + wfMove) <> 0) Then
  4876. WindowCommands := WindowCommands + [cmResize]; { Add resize command }
  4877. If (Flags AND wfClose <> 0) Then
  4878. WindowCommands := WindowCommands + [cmClose]; { Add close command }
  4879. If (Flags AND wfZoom <> 0) Then
  4880. WindowCommands := WindowCommands + [cmZoom]; { Add zoom command }
  4881. If Enable Then EnableCommands(WindowCommands) { Enable commands }
  4882. Else DisableCommands(WindowCommands); { Disable commands }
  4883. End;
  4884. END;
  4885. {--TWindow------------------------------------------------------------------}
  4886. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Mar98 LdB }
  4887. {---------------------------------------------------------------------------}
  4888. { You can save data to the stream compatable with the old original TV by }
  4889. { temporarily turning off the ofGrafVersion making the call to this store }
  4890. { routine and resetting the ofGrafVersion flag after the call. }
  4891. {---------------------------------------------------------------------------}
  4892. PROCEDURE TWindow.Store (Var S: TStream);
  4893. BEGIN
  4894. TGroup.Store(S); { Call group store }
  4895. S.Write(Flags, 1); { Write window flags }
  4896. S.Write(Number, 2); { Write window number }
  4897. S.Write(Palette, 2); { Write window palette }
  4898. S.Write(ZoomRect.A.X, 2); { Write zoom area x1 }
  4899. S.Write(ZoomRect.A.Y, 2); { Write zoom area y1 }
  4900. S.Write(ZoomRect.B.X, 2); { Write zoom area x2 }
  4901. S.Write(ZoomRect.B.Y, 2); { Write zoom area y2 }
  4902. PutSubViewPtr(S, Frame); { Write any frame }
  4903. S.WriteStr(Title); { Write title string }
  4904. END;
  4905. {--TWindow------------------------------------------------------------------}
  4906. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11Aug99 LdB }
  4907. {---------------------------------------------------------------------------}
  4908. PROCEDURE TWindow.HandleEvent (Var Event: TEvent);
  4909. VAR {$IFDEF OS_DOS} I, J: Integer; {$ENDIF} Min, Max: TPoint; Limits: TRect;
  4910. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  4911. PROCEDURE DragWindow (Mode: Byte);
  4912. VAR Limits: TRect; Min, Max: TPoint;
  4913. BEGIN
  4914. Owner^.GetExtent(Limits); { Get owner extents }
  4915. SizeLimits(Min, Max); { Restrict size }
  4916. DragView(Event, DragMode OR Mode, Limits, Min,
  4917. Max); { Drag the view }
  4918. ClearEvent(Event); { Clear the event }
  4919. END;
  4920. {$ENDIF}
  4921. BEGIN
  4922. Inherited HandleEvent(Event); { Call ancestor }
  4923. Case Event.What Of
  4924. evNothing: Exit; { Speeds up exit }
  4925. evCommand: { COMMAND EVENT }
  4926. Case Event.Command Of { Command type case }
  4927. cmResize: { RESIZE COMMAND }
  4928. If (Flags AND (wfMove + wfGrow) <> 0) { Window can resize }
  4929. AND (Owner <> Nil) Then Begin { Valid owner }
  4930. Owner^.GetExtent(Limits); { Owners extents }
  4931. SizeLimits(Min, Max); { Check size limits }
  4932. DragView(Event, DragMode OR (Flags AND
  4933. (wfMove + wfGrow)), Limits, Min, Max); { Drag the view }
  4934. ClearEvent(Event); { Clear the event }
  4935. End;
  4936. cmClose: { CLOSE COMMAND }
  4937. If (Flags AND wfClose <> 0) AND { Close flag set }
  4938. ((Event.InfoPtr = Nil) OR { None specific close }
  4939. (Event.InfoPtr = @Self)) Then Begin { Close to us }
  4940. ClearEvent(Event); { Clear the event }
  4941. If (State AND sfModal = 0) Then Close { Non modal so close }
  4942. Else Begin { Modal window }
  4943. Event.What := evCommand; { Command event }
  4944. Event.Command := cmCancel; { Cancel command }
  4945. PutEvent(Event); { Place on queue }
  4946. ClearEvent(Event); { Clear the event }
  4947. End;
  4948. End;
  4949. cmZoom: { ZOOM COMMAND }
  4950. If (Flags AND wfZoom <> 0) AND { Zoom flag set }
  4951. ((Event.InfoPtr = Nil) OR { No specific zoom }
  4952. (Event.InfoPtr = @Self)) Then Begin
  4953. Zoom; { Zoom our window }
  4954. ClearEvent(Event); { Clear the event }
  4955. End;
  4956. End;
  4957. evBroadcast: { BROADCAST EVENT }
  4958. If (Event.Command = cmSelectWindowNum) AND
  4959. (Event.InfoInt = Number) AND { Select our number }
  4960. (Options AND ofSelectable <> 0) Then Begin { Is view selectable }
  4961. Select; { Select our view }
  4962. ClearEvent(Event); { Clear the event }
  4963. End;
  4964. evKeyDown: Begin { KEYDOWN EVENT }
  4965. Case Event.KeyCode Of
  4966. kbTab: Begin { TAB KEY }
  4967. FocusNext(False); { Select next view }
  4968. ClearEvent(Event); { Clear the event }
  4969. End;
  4970. kbShiftTab: Begin { SHIFT TAB KEY }
  4971. FocusNext(True); { Select prior view }
  4972. ClearEvent(Event); { Clear the event }
  4973. End;
  4974. End;
  4975. End;
  4976. {$IFDEF OS_DOS} { DOS/DPMI CODE ONLY }
  4977. evMouseDown: { MOUSE DOWN EVENT }
  4978. If (GOptions AND goTitled <> 0) Then Begin { Must have title area }
  4979. If (GOptions AND goThickFramed <> 0) Then
  4980. I := 5 Else { Thick frame adjust }
  4981. If (Options AND ofFramed <> 0) Then I := 1 { Frame adjust }
  4982. Else I := 0; { No frame size }
  4983. If (Event.Where.Y > (RawOrigin.Y + I)) AND
  4984. (Event.Where.Y < RawOrigin.Y+FontHeight+I)
  4985. Then Begin { Within top line }
  4986. If (Current <> Nil) AND
  4987. (Current^.Options AND ofSelectable <> 0)
  4988. Then Current^.FocusFromTop Else
  4989. FocusFromTop;
  4990. If (Flags AND wfClose <> 0) Then Begin { Has close icon }
  4991. J := I + FontWidth; { Set X value }
  4992. If (Event.Where.X > RawOrigin.X+J) AND
  4993. (Event.Where.X < RawOrigin.X+J+2*FontWidth)
  4994. Then Begin { In close area }
  4995. Event.What := evCommand; { Command event }
  4996. Event.Command := cmClose; { Close command }
  4997. Event.InfoPtr := Nil; { Clear pointer }
  4998. PutEvent(Event); { Put event on queue }
  4999. ClearEvent(Event); { Clear the event }
  5000. Exit; { Now exit }
  5001. End;
  5002. End;
  5003. If (Owner <> Nil) AND (Flags AND wfMove <> 0)
  5004. Then DragWindow(dmDragMove); { Drag the window }
  5005. End Else If (Event.Where.X >= RawOrigin.X + RawSize.X-2*FontWidth) AND
  5006. (Event.Where.Y >= RawOrigin.Y + RawSize.Y - FontHeight)
  5007. Then If (Flags AND wfGrow <> 0) Then { Check grow flags }
  5008. DragWindow(dmDragGrow); { Change window size }
  5009. End;
  5010. {$ENDIF}
  5011. End; { Event.What case end }
  5012. END;
  5013. {--TWindow------------------------------------------------------------------}
  5014. { SizeLimits -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15Sep97 LdB }
  5015. {---------------------------------------------------------------------------}
  5016. PROCEDURE TWindow.SizeLimits (Var Min, Max: TPoint);
  5017. BEGIN
  5018. Inherited SizeLimits(Min, Max); { View size limits }
  5019. Min.X := MinWinSize.X; { Set min x size }
  5020. Min.Y := MinWinSize.Y; { Set min y size }
  5021. END;
  5022. {$IFNDEF OS_DOS}
  5023. {***************************************************************************}
  5024. { TWindow OBJECT WIN/NT/OS2 ONLY METHODS }
  5025. {***************************************************************************}
  5026. {--TWindow------------------------------------------------------------------}
  5027. { GetClassText -> Platforms WIN/NT/OS2 - Updated 18Jul99 LdB }
  5028. {---------------------------------------------------------------------------}
  5029. FUNCTION TWindow.GetClassText: String;
  5030. BEGIN
  5031. GetClassText := GetTitle(255); { Return window title }
  5032. END;
  5033. {--TWindow------------------------------------------------------------------}
  5034. { GetClassAttr -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  5035. {---------------------------------------------------------------------------}
  5036. FUNCTION TWindow.GetClassAttr: LongInt;
  5037. VAR Li: LongInt;
  5038. BEGIN
  5039. Li := Inherited GetClassAttr; { Call ancestor }
  5040. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5041. If (Flags AND wfZoom <> 0) Then Li := Li OR { Check zoom flags }
  5042. ws_MinimizeBox OR ws_MaximizeBox; { Add min/max boxes }
  5043. If (Flags AND wfClose <> 0) Then { Check close option }
  5044. Li := Li OR ws_SysMenu; { Set menu flag }
  5045. Li := Li OR ws_ClipSiblings OR ws_ClipChildren; { Clip other windows }
  5046. {$ENDIF}
  5047. {$IFDEF OS_OS2} { OS2 CODE }
  5048. If (Flags AND wfZoom <> 0) Then Li := Li OR { Check zoom flags }
  5049. fcf_MinButton OR fcf_MaxButton; { Add min/max boxes }
  5050. If (Flags AND wfClose <> 0) Then { Check close option }
  5051. Li := Li OR fcf_SysMenu; { Set menu flag }
  5052. {$ENDIF}
  5053. GetClassAttr := Li; { Return masks }
  5054. END;
  5055. {$ENDIF}
  5056. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  5057. { UNCOMPLETED OBJECT METHODS }
  5058. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  5059. {--TView--------------------------------------------------------------------}
  5060. { Exposed -> Platforms DOS/DPMI/WIN/OS2 - Checked 17Sep97 LdB }
  5061. {---------------------------------------------------------------------------}
  5062. { This needs big help!!!!! }
  5063. FUNCTION TView.Exposed: Boolean;
  5064. VAR ViewPort: ViewPortType;
  5065. BEGIN
  5066. GetViewSettings(ViewPort, TextModeGFV); { Fetch viewport }
  5067. If (State AND sfVisible<>0) AND { View visible }
  5068. (State AND sfExposed<>0) AND { View exposed }
  5069. OverlapsArea(ViewPort.X1, ViewPort.Y1,
  5070. ViewPort.X2, ViewPort.Y2) Then Exposed := True { Must be exposed }
  5071. Else Exposed := False; { Is hidden }
  5072. END;
  5073. {--TView--------------------------------------------------------------------}
  5074. { GraphLine -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Sep99 LdB }
  5075. {---------------------------------------------------------------------------}
  5076. PROCEDURE TView.GraphLine (X1, Y1, X2, Y2: Integer; Colour: Byte);
  5077. VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF} { DOS/DPMI VARIABLES }
  5078. {$IFDEF OS_WINDOWS} I: Word; ODc: hDc; {$ENDIF} { WIN/NT VARIABLES }
  5079. {$IFDEF OS_OS2} I: LongInt; Lp: PointL; OPs: HPs; {$ENDIF}{ OS2 VARIABLES }
  5080. BEGIN
  5081. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5082. GetViewSettings(ViewPort, TextModeGFV); { Get viewport settings }
  5083. If (TextModeGFV <> TRUE) Then Begin
  5084. SetColor(Colour); { Set line colour }
  5085. Line(RawOrigin.X + X1 - ViewPort.X1,
  5086. RawOrigin.Y + Y1 - ViewPort.Y1, RawOrigin.X + X2
  5087. - ViewPort.X1, RawOrigin.Y + Y2-ViewPort.Y1); { Draw the line }
  5088. End Else Begin { LEON???? }
  5089. End;
  5090. {$ENDIF}
  5091. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5092. If (HWindow <> 0) Then Begin { Valid window }
  5093. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5094. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5095. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5096. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5097. ODc := Dc; { Hold device context }
  5098. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5099. SelectObject(Dc, ColPen[Colour]); { Select line colour }
  5100. Case WriteMode Of
  5101. NormalPut: I := R2_CopyPen; { Normal overwrite }
  5102. AndPut: I := R2_MaskPen; { AND colour write }
  5103. OrPut: I := R2_MergePen; { OR colour write }
  5104. XorPut: I := R2_XORPen; { XOR colour write }
  5105. NotPut: I := R2_Not; { NOT colour write }
  5106. End;
  5107. SetRop2(Dc, I); { Set write mode }
  5108. {$IFDEF BIT_16} { 16 BIT WIN CODE }
  5109. WinProcs.MoveTo(Dc, X1, Y1); { Move to first point }
  5110. {$ELSE} { 32 BIT WIN/NT CODE }
  5111. MoveToEx(Dc, X1, Y1, Nil); { Move to first point }
  5112. {$ENDIF}
  5113. If (Abs(X2-X1) > 1) OR (Abs(Y2-Y1) > 1) Then { Not single point }
  5114. LineTo(Dc, X2, Y2); { Line to second point }
  5115. SetPixel(Dc, X2, Y2, ColRef[Colour]); { Draw last point }
  5116. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5117. Dc := ODc; { Reset held context }
  5118. End;
  5119. {$ENDIF}
  5120. {$IFDEF OS_OS2} { OS2 CODE }
  5121. If (HWindow <> 0) Then Begin { Valid window }
  5122. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5123. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5124. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5125. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5126. OPs := Ps; { Hold paint struct }
  5127. If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
  5128. Case WriteMode Of
  5129. NormalPut: I := fm_Overpaint; { Normal overwrite }
  5130. AndPut: I := fm_And; { AND colour write }
  5131. OrPut: I := fm_Or; { OR colour write }
  5132. XorPut: I := fm_Xor; { XOR colour write }
  5133. NotPut: I := fm_Invert; { NOT colour write }
  5134. End;
  5135. GPISetMix(Ps, I); { Set write mode }
  5136. GPISetColor(Ps, ColRef[Colour]);
  5137. Lp.X := X1; { Transfer x1 value }
  5138. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5139. GPIMove(Ps, Lp); { Move to first point }
  5140. Lp.X := X2; { Transfer x2 value }
  5141. Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
  5142. GPILine(Ps, Lp); { Line to second point }
  5143. If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
  5144. Ps := OPs; { Reset held struct }
  5145. End;
  5146. {$ENDIF}
  5147. END;
  5148. PROCEDURE TView.GraphRectangle (X1, Y1, X2, Y2: Integer; Colour: Byte);
  5149. VAR {$IFDEF OS_DOS} ViewPort: ViewPortType; {$ENDIF}
  5150. {$IFDEF OS_WINDOWS} I: Word; ODc: hDc; {$ENDIF}
  5151. {$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
  5152. BEGIN
  5153. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5154. If (TextModeGFV <> TRUE) Then Begin { GRAPHICS MODE GFV }
  5155. SetColor(Colour); { Set line colour }
  5156. GetViewSettings(ViewPort, TextModeGFV);
  5157. Rectangle(RawOrigin.X + X1 - ViewPort.X1, RawOrigin.Y + Y1
  5158. - ViewPort.Y1, RawOrigin.X + X2 - ViewPort.X1,
  5159. RawOrigin.Y+Y2-ViewPort.Y1); { Draw a rectangle }
  5160. End Else Begin { LEON???? }
  5161. End;
  5162. {$ENDIF}
  5163. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5164. If (HWindow <> 0) Then Begin { Valid window }
  5165. X1 := X1 - FrameSize;
  5166. X2 := X2 - FrameSize;
  5167. Y1 := Y1 - CaptSize;
  5168. Y2 := Y2 - CaptSize;
  5169. ODc := Dc; { Hold device context }
  5170. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5171. SelectObject(Dc, ColPen[Colour]);
  5172. Case WriteMode Of
  5173. NormalPut: I := R2_CopyPen; { Normal overwrite }
  5174. AndPut: I := R2_MaskPen; { AND colour write }
  5175. OrPut: I := R2_MergePen; { OR colour write }
  5176. XorPut: I := R2_XORPen; { XOR colour write }
  5177. NotPut: I := R2_Not; { NOT colour write }
  5178. End;
  5179. SetRop2(Dc, I);
  5180. {$IFDEF WIN32}
  5181. MoveToEx(Dc, X1, Y1, Nil); { Move to first point }
  5182. {$ELSE}
  5183. WinProcs.MoveTo(Dc, X1, Y1); { Move to first point }
  5184. {$ENDIF}
  5185. LineTo(Dc, X2, Y1); { Line to second point }
  5186. LineTo(Dc, X2, Y2); { Line to third point }
  5187. LineTo(Dc, X1, Y2); { Line to fourth point }
  5188. LineTo(Dc, X1, Y1); { Line to first point }
  5189. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5190. Dc := ODc; { Reset held context }
  5191. End;
  5192. {$ENDIF}
  5193. {$IFDEF OS_OS2} { OS2 CODE }
  5194. If (HWindow <> 0) Then Begin { Valid window }
  5195. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5196. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5197. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5198. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5199. OPs := Ps; { Hold paint struct }
  5200. If (Ps = 0) Then Ps := WinGetPS(Client); { Create paint struct }
  5201. GPISetColor(Ps, ColRef[Colour]); { Set colour }
  5202. Lp.X := X1; { Transfer x1 value }
  5203. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5204. GPIMove(Ps, Lp); { Move to first point }
  5205. Lp.X := X2; { Transfer x2 value }
  5206. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5207. GPILine(Ps, Lp); { Line to second point }
  5208. Lp.X := X2; { Transfer x2 value }
  5209. Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
  5210. GPILine(Ps, Lp); { Line to third point }
  5211. Lp.X := X1; { Transfer x1 value }
  5212. Lp.Y := RawSize.Y-Y2; { Transfer y2 value }
  5213. GPILine(Ps, Lp); { Line to fourth point }
  5214. Lp.X := X1; { Transfer x1 value }
  5215. Lp.Y := RawSize.Y-Y1; { Transfer y1 value }
  5216. GPILine(Ps, Lp); { Line to first point }
  5217. If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
  5218. Ps := OPs; { Reset held struct }
  5219. End;
  5220. {$ENDIF}
  5221. END;
  5222. {--TView--------------------------------------------------------------------}
  5223. { ClearArea -> Platforms DOS/DPMI/WIN/OS2 - Checked 19Sep97 LdB }
  5224. {---------------------------------------------------------------------------}
  5225. PROCEDURE TView.ClearArea (X1, Y1, X2, Y2: Integer; Colour: Byte);
  5226. VAR {$IFDEF OS_DOS} X, Y: Integer; ViewPort: ViewPortType; {$ENDIF}
  5227. {$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
  5228. {$IFDEF OS_OS2} Lp: PointL; OPs: HPs; {$ENDIF}
  5229. BEGIN
  5230. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5231. GetViewSettings(ViewPort, TextModeGFV); { Get viewport }
  5232. If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL GFV MODE }
  5233. SetFillStyle(SolidFill, Colour); { Set colour up }
  5234. Bar(RawOrigin.X+X1-ViewPort.X1, RawOrigin.Y+Y1-
  5235. ViewPort.Y1, RawOrigin.X+X2-ViewPort.X1,
  5236. RawOrigin.Y+Y2-ViewPort.Y1); { Clear the area }
  5237. End Else Begin { TEXT MODE GFV }
  5238. X1 := (RawOrigin.X+X1) DIV SysFontWidth;
  5239. Y1 := (RawOrigin.Y+Y1) DIV SysFontHeight;
  5240. X2 := (RawOrigin.X+X2) DIV SysFontWidth;
  5241. Y2 := (RawOrigin.Y+Y2) DIV SysFontHeight;
  5242. For Y := Y1 To Y2 Do
  5243. For X := X1 To X2 Do Begin
  5244. Mem[$B800:$0+(Y*ScreenWidth+X)*2] := $20;
  5245. Mem[$B800:$0+(Y*ScreenWidth+X)*2+1] := Colour SHL 4;
  5246. End;
  5247. End;
  5248. {$ENDIF}
  5249. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5250. If (HWindow <> 0) Then Begin { Valid window }
  5251. X1 := X1 - FrameSize; { Correct for frame }
  5252. Y1 := Y1 - CaptSize; { Correct for caption }
  5253. X2 := X2 - FrameSize; { Correct for frame }
  5254. Y2 := Y2 - CaptSize; { Correct for caption }
  5255. ODc := Dc; { Hold device context }
  5256. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5257. SelectObject(Dc, ColPen[Colour]);
  5258. SelectObject(Dc, ColBrush[Colour]);
  5259. {$IFNDEF PPC_SPEED}
  5260. Rectangle(Dc, X1, Y1, X2+1, Y2+1);
  5261. {$ELSE} { SPEEDSOFT SYBIL2+ }
  5262. WinGDI.Rectangle(Dc, X1, Y1, X2+1, Y2+1);
  5263. {$ENDIF}
  5264. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5265. Dc := ODc; { Reset held context }
  5266. End;
  5267. {$ENDIF}
  5268. {$IFDEF OS_OS2} { OS2 CODE }
  5269. If (HWindow <> 0) Then Begin { Valid window }
  5270. X1 := X1 - FrameSize; { Adjust X1 for frame }
  5271. X2 := X2 - FrameSize; { Adjust X2 for frame }
  5272. Y1 := Y1 - CaptSize; { Adjust Y1 for title }
  5273. Y2 := Y2 - CaptSize; { Adjust Y2 for title }
  5274. OPs := Ps; { Hold paint struct }
  5275. If (Ps = 0) Then Ps := WinGetPs(Client); { Create paint struct }
  5276. GpiSetColor(Ps, ColRef[Colour]);
  5277. Lp.X := X1;
  5278. Lp.Y := RawSize.Y-Y1;
  5279. GpiMove(Ps, Lp);
  5280. Lp.X := X2;
  5281. Lp.Y := RawSize.Y-Y2;
  5282. GpiBox(Ps, dro_Fill, Lp, 0, 0);
  5283. If (OPs = 0) Then WinReleasePS(Ps); { Release paint struct }
  5284. Ps := OPs; { Reset held struct }
  5285. End;
  5286. {$ENDIF}
  5287. END;
  5288. PROCEDURE TView.GraphArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad: Integer;
  5289. Colour: Byte);
  5290. CONST RadConv = 57.2957795130823229; { Degrees per radian }
  5291. VAR X1, Y1, X2, Y2, X3, Y3: Integer; {$IFDEF OS_WINDOWS} ODc: hDc; {$ENDIF}
  5292. BEGIN
  5293. {$IFDEF OS_WINDOWS}
  5294. Xc := Xc - FrameSize;
  5295. Yc := Yc - CaptSize;
  5296. {$ENDIF}
  5297. While (Ea < -360) Do Ea := Ea + 360; { Max of a full circle }
  5298. While (Ea > 360) Do Ea := Ea - 360; { Max of a full circle }
  5299. Sa := Sa/RadConv; { Convert to radians }
  5300. Ea := Ea/RadConv; { Convert to radians }
  5301. X1 := Xc + Round(Sin(Sa)*XRad); { Calc 1st x value }
  5302. Y1 := Yc - Round(Cos(Sa)*YRad); { Calc 1st y value }
  5303. X2 := Xc + Round(Sin(Sa+Ea)*XRad); { Calc 2nd x value }
  5304. Y2 := Yc - Round(Cos(Sa+Ea)*YRad); { Calc 2nd y value }
  5305. X3 := X2; { Use X2 value }
  5306. Y3 := Y2; { Use Y2 value }
  5307. If (Abs(Ea) > Pi) Then Begin
  5308. X3 := Xc + Round(Sin(Sa+Pi)*XRad); { Calc 3rd x value }
  5309. Y3 := Yc - Round(Cos(Sa+Pi)*YRad); { Calc 3rd y value }
  5310. End;
  5311. {$IFDEF OS_WINDOWS}
  5312. If (HWindow <> 0) Then Begin { Valid window }
  5313. ODc := Dc; { Hold device context }
  5314. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5315. SelectObject(Dc, ColPen[Colour]); { Pen colour }
  5316. If (Abs(X1-X3) > 1) OR (Abs(Y1-Y3) > 1) { Must exceed 2x2 arc }
  5317. Then Begin
  5318. If (Ea < 0) Then
  5319. Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
  5320. X1, Y1, X2, Y2) Else { Draw c/clkwise arc }
  5321. Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
  5322. X2, Y2, X1, Y1); { Draw clockwise arc }
  5323. End;
  5324. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5325. Dc := ODc; { Reset held context }
  5326. End;
  5327. {$ENDIF}
  5328. END;
  5329. PROCEDURE TView.FilletArc (Xc, Yc: Integer; Sa, Ea: Real; XRad, YRad, Ht: Integer;
  5330. Colour: Byte);
  5331. CONST RadConv = 57.2957795130823229; { Degrees per radian }
  5332. {$IFDEF OS_WINDOWS} VAR X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer; ODc: hDc; {$ENDIF}
  5333. BEGIN
  5334. {$IFDEF OS_WINDOWS}
  5335. If (HWindow <> 0) Then Begin { Valid window }
  5336. Xc := Xc - FrameSize;
  5337. Yc := Yc - CaptSize;
  5338. ODc := Dc; { Hold device context }
  5339. If (Dc = 0) Then Dc := GetDC(HWindow); { Create a context }
  5340. Ea := (Ea-Sa);
  5341. While (Ea<-360) Do Ea := Ea+360; { One lap only }
  5342. While (Ea>360) Do Ea := Ea-360; { One lap only }
  5343. X1 := Round(Sin(Sa/RadConv)*XRad);
  5344. Y1 := -Round(Cos(Sa/RadConv)*YRad); { Calc 1st values }
  5345. X2 := Round(Sin((Sa+Ea)/RadConv)*XRad);
  5346. Y2 := -Round(Cos((Sa+Ea)/RadConv)*YRad); { Calc 2nd values }
  5347. X3 := Round(Sin(Sa/RadConv)*(XRad+Ht));
  5348. Y3 := -Round(Cos(Sa/RadConv)*(YRad+Ht)); { Calc 3rd values }
  5349. X4 := Round(Sin((Sa+Ea)/RadConv)*(XRad+Ht));
  5350. Y4 := -Round(Cos((Sa+Ea)/RadConv)*(YRad+Ht)); { Calc 4th values }
  5351. SelectObject(Dc, ColPen[Colour]); { Pen colour }
  5352. {$IFDEF WIN32}
  5353. MoveToEx(Dc, Xc+X1, Yc+Y1, Nil); { Move to first point }
  5354. {$ELSE}
  5355. WinProcs.MoveTo(Dc, Xc+X1, Yc+Y1); { Move to first point }
  5356. {$ENDIF}
  5357. LineTo(Dc, Xc+X3, Yc+Y3);
  5358. {$IFDEF WIN32}
  5359. MoveToEx(Dc, Xc+X2, Yc+Y2, Nil);
  5360. {$ELSE}
  5361. WinProcs.MoveTo(Dc, Xc+X2, Yc+Y2);
  5362. {$ENDIF}
  5363. LineTo(Dc, Xc+X4, Yc+Y4);
  5364. If (Ea < 0) Then
  5365. Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht,
  5366. Xc+X1, Yc+Y1, Xc+X2, Yc+Y2) Else
  5367. Arc(Dc, Xc-XRad-Ht, Yc-YRad-Ht, Xc+XRad+Ht, Yc+YRad+Ht,
  5368. Xc+X2, Yc+Y2, Xc+X1, Yc+Y1); { Draw arc }
  5369. If (Ea < 0) Then
  5370. Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
  5371. Xc+X3, Yc+Y3, Xc+X4, Yc+Y4) Else
  5372. Arc(Dc, Xc-XRad, Yc-YRad, Xc+XRad, Yc+YRad,
  5373. Xc+X4, Yc+Y4, Xc+X3, Yc+Y3); { Draw arc }
  5374. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5375. Dc := ODc; { Reset held context }
  5376. End;
  5377. {$ENDIF}
  5378. END;
  5379. {--TView--------------------------------------------------------------------}
  5380. { BiColorRectangle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06May98 LdB }
  5381. {---------------------------------------------------------------------------}
  5382. PROCEDURE TView.BicolorRectangle (X1, Y1, X2, Y2: Integer; Light, Dark: Byte;
  5383. Down: Boolean);
  5384. VAR UpperLeft, RightDown: Byte;
  5385. BEGIN
  5386. If Down Then Begin
  5387. UpperLeft := Dark; { Dark upper left }
  5388. RightDown := Light; { Light down }
  5389. End Else Begin
  5390. UpperLeft := Light; { Light upper left }
  5391. RightDown := Dark; { Dark down }
  5392. End;
  5393. GraphLine(X1, Y1, X1, Y2, UpperLeft); { Draw left side }
  5394. GraphLine(X1, Y1, X2, Y1, UpperLeft); { Draw top line }
  5395. GraphLine(X1, Y2, X2, Y2, RightDown); { Draw bottom line }
  5396. GraphLine(X2, Y1, X2, Y2, RightDown); { Draw right line }
  5397. END;
  5398. PROCEDURE TView.WriteBuf (X, Y, W, H: Integer; Var Buf);
  5399. VAR I, J, K, L, CW: Integer; P: PDrawBuffer;
  5400. {$IFDEF OS_DOS} Tix, Tiy: Integer; ViewPort: ViewPortType; {$ENDIF}
  5401. {$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF}
  5402. {$IFDEF OS_OS2} OPs: HPs; Pt: PointL; {$ENDIF}
  5403. BEGIN
  5404. If (State AND sfVisible <> 0) AND { View is visible }
  5405. (State AND sfIconised = 0) AND { View is not icon}
  5406. (State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
  5407. {$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
  5408. Then Begin
  5409. P := @TDrawBuffer(Buf); { Set draw buffer ptr }
  5410. L := 0; { Set buffer position }
  5411. If (GOptions AND (goGraphical + goGraphView)= 0) Then Begin { Not raw graphical }
  5412. X := X * SysFontWidth; { X graphical adjust }
  5413. Y := Y * SysFontHeight; { Y graphical adjust }
  5414. End;
  5415. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5416. GetViewSettings(ViewPort, TextModeGFV); { Get current viewport }
  5417. X := X + RawOrigin.X - ViewPort.X1; { Calc x position }
  5418. Y := Y + RawOrigin.Y - ViewPort.Y1; { Calc y position }
  5419. {$ENDIF}
  5420. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5421. ODc := Dc; { Hold device context }
  5422. If (Dc = 0) Then Dc := GetDC(HWindow); { If needed get context }
  5423. SelectObject(Dc, DefGFVFont); { Select the font }
  5424. {$ENDIF}
  5425. {$IFDEF OS_OS2} { OS2 CODE }
  5426. OPs := Ps; { Hold pres space }
  5427. If (Ps = 0) Then Ps := WinGetPS(Client); { If needed get PS }
  5428. GPISetCharSet(Ps, DefGFVFont); { Select the font }
  5429. GpiSetBackMix(Ps, bm_OverPaint); { Set overpaint mode }
  5430. {$ENDIF}
  5431. For J := 1 To H Do Begin { For each line }
  5432. K := X; { Reset x position }
  5433. For I := 0 To (W-1) Do Begin { For each character }
  5434. Cw := TextWidth(Chr(Lo(P^[L]))); { Width of this char }
  5435. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5436. If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
  5437. SetFillStyle(SolidFill, Hi(P^[L]) AND
  5438. $F0 SHR 4); { Set back colour }
  5439. SetColor(Hi(P^[L]) AND $0F); { Set text colour }
  5440. Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
  5441. OutTextXY(K, Y+2, Chr(Lo(P^[L]))); { Write text char }
  5442. End Else Begin { TEXT MODE GFV }
  5443. Tix := (K + ViewPort.X1) DIV SysFontWidth;
  5444. Tiy := (Y + 2 + ViewPort.Y1) DIV SysFontHeight;
  5445. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Lo(P^[L]);
  5446. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := Hi(P^[L]);
  5447. End;
  5448. {$ENDIF}
  5449. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5450. SetBkColor(Dc, ColRef[Hi(P^[L]) AND $F0
  5451. SHR 4]); { Set back colour }
  5452. SetTextColor(Dc, ColRef[Hi(P^[L])
  5453. AND $0F]); { Set text colour }
  5454. TextOut(Dc, K, Y, @P^[L], 1); { Write text char }
  5455. {$ENDIF}
  5456. {$IFDEF OS_OS2} { OS2 CODE }
  5457. GPISetBackColor(Ps, ColRef[Hi(P^[L])
  5458. AND $F0 SHR 4]); { Set back colour }
  5459. GpiSetColor(Ps, ColRef[Hi(P^[L])
  5460. AND $0F]); { Set text colour }
  5461. Pt.X := K;
  5462. Pt.Y := RawSize.Y - Y - FontHeight + 5;
  5463. GpiCharStringAt(Ps, Pt, 1, @P^[L]); { Write text char }
  5464. {$ENDIF}
  5465. K := K + Cw; { Add char width }
  5466. Inc(L); { Next character }
  5467. End;
  5468. Y := Y + SysFontHeight; { Next line down }
  5469. End;
  5470. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5471. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5472. Dc := ODc; { Restore old context }
  5473. {$ENDIF}
  5474. {$IFDEF OS_OS2} { OS2 CODE }
  5475. If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
  5476. Ps := OPs; { Restore original PS }
  5477. {$ENDIF}
  5478. End;
  5479. END;
  5480. PROCEDURE TView.WriteLine (X, Y, W, H: Integer; Var Buf);
  5481. VAR I, J, K, Cw: Integer; P: PDrawBuffer;
  5482. {$IFDEF OS_DOS} Tix, Tiy: Integer; ViewPort: ViewPortType; {$ENDIF}
  5483. {$IFDEF OS_WINDOWS} ODc: HDc; {$ENDIF}
  5484. {$IFDEF OS_OS2} OPs: HPs; Pt: PointL; {$ENDIF}
  5485. BEGIN
  5486. If (State AND sfVisible <> 0) AND { View is visible }
  5487. (State AND sfIconised = 0) AND { View is not icon}
  5488. (State AND sfExposed <> 0) AND (W > 0) AND (H > 0) { View is exposed }
  5489. {$IFNDEF OS_DOS} AND (HWindow <> 0) {$ENDIF} { WIN/NT/OS2 CODE }
  5490. Then Begin
  5491. P := @TDrawBuffer(Buf); { Set draw buffer ptr }
  5492. If (GOptions AND (goGraphical + goGraphView)= 0) Then Begin { Not raw graphical }
  5493. X := X * SysFontWidth; { X graphical adjust }
  5494. Y := Y * SysFontHeight; { Y graphical adjust }
  5495. End;
  5496. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5497. GetViewSettings(ViewPort, TextModeGFV); { Get current viewport }
  5498. X := X + RawOrigin.X - ViewPort.X1; { Calc x position }
  5499. Y := Y + RawOrigin.Y - ViewPort.Y1; { Calc y position }
  5500. {$ENDIF}
  5501. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5502. ODc := Dc; { Hold device context }
  5503. If (Dc = 0) Then Dc := GetDC(HWindow); { If needed get context }
  5504. SelectObject(Dc, DefGFVFont); { Select the font }
  5505. {$ENDIF}
  5506. {$IFDEF OS_OS2} { OS2 CODE }
  5507. OPs := Ps; { Hold pres space }
  5508. If (Ps = 0) Then Ps := WinGetPS(Client); { If needed get PS }
  5509. GPISetCharSet(Ps, DefGFVFont); { Select the font }
  5510. GpiSetBackMix(Ps, bm_OverPaint); { Set overpaint mode }
  5511. {$ENDIF}
  5512. For J := 1 To H Do Begin { For each line }
  5513. K := X; { Reset x position }
  5514. For I := 0 To (W-1) Do Begin { For each character }
  5515. Cw := TextWidth(Chr(Lo(P^[I]))); { Width of this char }
  5516. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5517. If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
  5518. SetFillStyle(SolidFill, Hi(P^[I]) AND
  5519. $F0 SHR 4); { Set back colour }
  5520. SetColor(Hi(P^[I]) AND $0F); { Set text colour }
  5521. Bar(K, Y, K+Cw, Y+FontHeight-1); { Clear text backing }
  5522. OutTextXY(K, Y+2, Chr(Lo(P^[I]))); { Write text char }
  5523. End Else Begin { TEXT MODE GFV }
  5524. Tix := (K + ViewPort.X1) DIV SysFontWidth;
  5525. Tiy := (Y + ViewPort.Y1 + 2) DIV SysFontHeight;
  5526. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Lo(P^[I]);
  5527. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := Hi(P^[I]);
  5528. End;
  5529. {$ENDIF}
  5530. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5531. SetBkColor(Dc, ColRef[Hi(P^[I]) AND $F0
  5532. SHR 4]); { Set back colour }
  5533. SetTextColor(Dc, ColRef[Hi(P^[I])
  5534. AND $0F]); { Set text colour }
  5535. TextOut(Dc, K, Y, @P^[I], 1); { Write text char }
  5536. {$ENDIF}
  5537. {$IFDEF OS_OS2} { OS2 CODE }
  5538. GPISetBackColor(Ps, ColRef[Hi(P^[I])
  5539. AND $F0 SHR 4]); { Set back colour }
  5540. GpiSetColor(Ps, ColRef[Hi(P^[I])
  5541. AND $0F]); { Set text colour }
  5542. Pt.X := K;
  5543. Pt.Y := RawSize.Y - Y - FontHeight + 5;
  5544. GpiCharStringAt(Ps, Pt, 1, @P^[I]); { Write text char }
  5545. {$ENDIF}
  5546. K := K + Cw; { Add char width }
  5547. End;
  5548. Y := Y + SysFontHeight; { Next line down }
  5549. End;
  5550. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5551. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5552. Dc := ODc; { Restore old context }
  5553. {$ENDIF}
  5554. {$IFDEF OS_OS2} { OS2 CODE }
  5555. If (OPs = 0) Then WinReleasePS(Ps); { Release pres space }
  5556. Ps := OPs; { Restore original PS }
  5557. {$ENDIF}
  5558. End;
  5559. END;
  5560. {--TView--------------------------------------------------------------------}
  5561. { MakeLocal -> Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB }
  5562. {---------------------------------------------------------------------------}
  5563. PROCEDURE TView.MakeLocal (Source: TPoint; Var Dest: TPoint);
  5564. BEGIN
  5565. If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW }
  5566. Dest.X := (Source.X-RawOrigin.X) DIV FontWidth; { Local x value }
  5567. Dest.Y := (Source.Y-RawOrigin.Y) DIV FontHeight; { Local y value }
  5568. End Else Begin { OLD MODE TVIEW }
  5569. Dest.X := Source.X - Origin.X; { Local x value }
  5570. Dest.Y := Source.Y - Origin.Y; { Local y value }
  5571. End;
  5572. END;
  5573. {--TView--------------------------------------------------------------------}
  5574. { MakeGlobal -> Platforms DOS/DPMI/WIN/OS2 - Checked 12Sep97 LdB }
  5575. {---------------------------------------------------------------------------}
  5576. PROCEDURE TView.MakeGlobal (Source: TPoint; Var Dest: TPoint);
  5577. BEGIN
  5578. If (Options AND ofGFVModeView <> 0) Then Begin { GFV MODE TVIEW }
  5579. Dest.X := Source.X*FontWidth + RawOrigin.X; { Global x value }
  5580. Dest.Y := Source.Y*FontHeight + RawOrigin.Y; { Global y value }
  5581. End Else Begin { OLD MODE TVIEW }
  5582. Dest.X := Source.X + Origin.X; { Global x value }
  5583. Dest.Y := Source.Y + Origin.Y; { Global y value }
  5584. End;
  5585. END;
  5586. PROCEDURE TView.WriteStr (X, Y: Integer; Str: String; Color: Byte);
  5587. VAR Fc, Bc, B: Byte; X1, Y1, X2, Y2: Integer;
  5588. {$IFDEF OS_DOS} Tix, Tiy, Ti: Integer; ViewPort: ViewPortType; {$ENDIF}
  5589. {$IFDEF OS_WINDOWS} ODc: HDc; P: Pointer; {$ENDIF}
  5590. {$IFDEF OS_OS2} OPs: HPs; P: Pointer; Pt: PointL; {$ENDIF}
  5591. BEGIN
  5592. If (State AND sfVisible <> 0) AND { View is visible }
  5593. (State AND sfExposed <> 0) AND { View is exposed }
  5594. (State AND sfIconised = 0) AND { View not iconized }
  5595. (Length(Str) > 0) Then Begin { String is valid }
  5596. Fc := GetColor(Color); { Get view color }
  5597. Bc := Fc AND $F0 SHR 4; { Calc back colour }
  5598. Fc := Fc AND $0F; { Calc text colour }
  5599. If RevCol Then Begin
  5600. B := Bc;
  5601. Bc := Fc;
  5602. Fc := B;
  5603. End;
  5604. {$IFDEF OS_DOS}
  5605. If (X >= 0) AND (Y >= 0) Then Begin
  5606. X := RawOrigin.X+X*FontWidth; { X position }
  5607. Y := RawOrigin.Y+Y*FontHeight; { Y position }
  5608. End Else Begin
  5609. X := RawOrigin.X + Abs(X);
  5610. Y := RawOrigin.Y + Abs(Y);
  5611. End;
  5612. GetViewSettings(ViewPort, TextModeGFV);
  5613. If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
  5614. SetFillStyle(SolidFill, Bc); { Set fill style }
  5615. Bar(X-ViewPort.X1, Y-ViewPort.Y1,
  5616. X-ViewPort.X1+Length(Str)*FontWidth,
  5617. Y-ViewPort.Y1+FontHeight-1);
  5618. SetColor(Fc);
  5619. OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1+2, Str);{ Write text char }
  5620. End Else Begin { TEXT MODE GFV }
  5621. Tix := X DIV SysFontWidth;
  5622. Tiy := Y DIV SysFontHeight;
  5623. For Ti := 1 To length(Str) Do Begin
  5624. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Ord(Str[Ti]);
  5625. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := GetColor(Color);
  5626. Tix := Tix + SysFontWidth;
  5627. End;
  5628. End;
  5629. {$ENDIF}
  5630. {$IFDEF OS_WINDOWS}
  5631. If (HWindow <> 0) Then Begin
  5632. ODc := Dc; { Hold device handle }
  5633. If (Dc = 0) Then Dc := GetDC(HWindow); { Chk capture context }
  5634. SelectObject(Dc, DefGFVFont);
  5635. SetTextColor(Dc, ColRef[Fc]); { Set text colour }
  5636. SetBkColor(Dc, ColRef[Bc]); { Set back colour }
  5637. If (GOptions AND goGraphView <> 0) OR (X < 0)
  5638. OR (Y < 0) Then Begin
  5639. X := Abs(X);
  5640. Y := Abs(Y);
  5641. X1 := X - FrameSize; { Left position }
  5642. Y1 := Y - CaptSize; { Top position }
  5643. X2 := X1 + TextWidth(Str); { Right position }
  5644. End Else Begin
  5645. X1 := X * FontWidth - FrameSize; { Left position }
  5646. Y1 := Y * FontHeight - CaptSize; { Top position }
  5647. X2 := X1 + Length(Str)*FontWidth; { Right position }
  5648. End;
  5649. Y2 := Y1 + FontHeight; { Bottom position }
  5650. SelectObject(Dc, ColPen[Bc]); { Select pen }
  5651. SelectObject(Dc, ColBrush[Bc]); { Select brush }
  5652. P := @Str[1];
  5653. Rectangle(Dc, X1, Y1, X2, Y2); { Clear the area }
  5654. {$IFNDEF PPC_SPEED}
  5655. TextOut(Dc, X1, Y1, P, Length(Str)); { Write text data }
  5656. {$ELSE} { SPEEDSOFT SYBIL2+ }
  5657. TextOut(Dc, X1, Y1, CString(P), Length(Str)); { Write text data }
  5658. {$ENDIF}
  5659. If (ODc = 0) Then ReleaseDC(HWindow, Dc); { Release context }
  5660. Dc := ODc; { Clear device handle }
  5661. End;
  5662. {$ENDIF}
  5663. {$IFDEF OS_OS2}
  5664. If (HWindow <> 0) Then Begin
  5665. OPs := Ps; { Hold device handle }
  5666. If (Ps = 0) Then Ps := WinGetPs(Client); { Chk capture context }
  5667. {SelectObject(Dc, DefGFVFont);}
  5668. If (GOptions AND goGraphView <> 0) OR (X < 0)
  5669. OR (Y < 0) Then Begin
  5670. X := Abs(X);
  5671. Y := Abs(Y);
  5672. X1 := X - FrameSize; { Left position }
  5673. Y1 := Y - CaptSize; { Top position }
  5674. X2 := X1 + TextWidth(Str); { Right position }
  5675. End Else Begin
  5676. X1 := X * FontWidth - FrameSize; { Left position }
  5677. Y1 := Y * FontHeight - CaptSize; { Top position }
  5678. X2 := X1 + Length(Str)*FontWidth; { Right position }
  5679. End;
  5680. Y2 := Y1 + FontHeight; { Bottom position }
  5681. {SelectObject(Dc, ColPen[Bc]);} { Select pen }
  5682. {SelectObject(Dc, ColBrush[Bc]);} { Select brush }
  5683. P := @Str[1];
  5684. (*Pt.X := X1;
  5685. Pt.Y := RawSize.Y - Y1;
  5686. GpiMove(Ps, Pt);
  5687. Pt.X := X2;
  5688. Pt.Y := RawSize.Y - Y2;
  5689. GpiSetColor(Ps, ColRef[Bc]); { Set text colour }
  5690. GpiBox(Ps, dro_Fill, Pt, 0, 0);*)
  5691. GpiSetColor(Ps, ColRef[Fc]); { Set text colour }
  5692. GpiSetBackColor(Ps, ColRef[Bc]); { Set back colour }
  5693. GpiSetBackMix(Ps, bm_OverPaint );
  5694. Pt.X := X1;
  5695. Pt.Y := RawSize.Y - Y1 - FontHeight + 5;
  5696. GpiCharStringAt(Ps, Pt, Length(Str), P); { Write text char }
  5697. If (OPs = 0) Then WinReleasePs(Ps); { Release context }
  5698. Ps := OPs; { Clear device handle }
  5699. End;
  5700. {$ENDIF}
  5701. End;
  5702. END;
  5703. PROCEDURE TView.WriteChar (X, Y: Integer; C: Char; Color: Byte;
  5704. Count: Integer);
  5705. {$IFDEF OS_DOS}
  5706. VAR Fc, Bc: Byte; I, Ti, Tix, Tiy: Integer; Col: Word; S: String; ViewPort: ViewPortType;
  5707. {$ENDIF}
  5708. BEGIN
  5709. {$IFDEF OS_DOS}
  5710. If (State AND sfVisible <> 0) AND { View visible }
  5711. (State AND sfExposed <> 0) Then Begin { View exposed }
  5712. GetViewSettings(ViewPort, TextModeGFV);
  5713. Col := GetColor(Color); { Get view color }
  5714. Fc := Col AND $0F; { Foreground colour }
  5715. Bc := Col AND $F0 SHR 4; { Background colour }
  5716. X := RawOrigin.X + X*FontWidth; { X position }
  5717. Y := RawOrigin.Y + Y*FontHeight; { Y position }
  5718. FillChar(S[1], 255, C); { Fill the string }
  5719. While (Count>0) Do Begin
  5720. If (Count>255) Then I := 255 Else I := Count; { Size to make }
  5721. S[0] := Chr(I); { Set string length }
  5722. If (TextModeGFV <> TRUE) Then Begin { GRAPHICAL MODE GFV }
  5723. SetFillStyle(SolidFill, Bc); { Set fill style }
  5724. Bar(X-ViewPort.X1, Y-ViewPort.Y1,
  5725. X-ViewPort.X1+Length(S)*FontWidth,
  5726. Y-ViewPort.Y1+FontHeight-1);
  5727. SetColor(Fc);
  5728. OutTextXY(X-ViewPort.X1, Y-ViewPort.Y1, S); { Write text char }
  5729. End Else Begin { TEXT MODE GFV }
  5730. Tix := X DIV SysFontWidth;
  5731. Tiy := Y DIV SysFontHeight;
  5732. For Ti := 1 To length(S) Do Begin
  5733. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2] := Ord(S[Ti]);
  5734. Mem[$B800:$0+((Tiy * ScreenWidth)+Tix)*2+1] := GetColor(Color);
  5735. Tix := Tix + SysFontWidth;
  5736. End;
  5737. End;
  5738. Count := Count - I; { Subtract count }
  5739. X := X + I*FontWidth; { Move x position }
  5740. End;
  5741. End;
  5742. {$ENDIF}
  5743. END;
  5744. PROCEDURE TView.DragView (Event: TEvent; Mode: Byte; Var Limits: TRect;
  5745. MinSize, MaxSize: TPoint);
  5746. VAR PState: Word; Mouse, Q, R, P, S, Op1, Op2: TPoint; SaveBounds: TRect;
  5747. FUNCTION Min (I, J: Integer): Integer;
  5748. BEGIN
  5749. If (I < J) Then Min := I Else Min := J; { Select minimum }
  5750. END;
  5751. FUNCTION Max (I, J: Integer): Integer;
  5752. BEGIN
  5753. If (I > J) Then Max := I Else Max := J; { Select maximum }
  5754. END;
  5755. PROCEDURE MoveGrow (P, S: TPoint);
  5756. VAR R: TRect;
  5757. BEGIN
  5758. S.X := Min(Max(S.X, MinSize.X), MaxSize.X); { Minimum S.X value }
  5759. S.Y := Min(Max(S.Y, MinSize.Y), MaxSize.Y); { Minimum S.Y value }
  5760. P.X := Min(Max(P.X, Limits.A.X - S.X + 1),
  5761. Limits.B.X - 1); { Minimum P.X value }
  5762. P.Y := Min(Max(P.Y, Limits.A.Y - S.Y + 1),
  5763. Limits.B.Y - 1); { Mimimum P.Y value }
  5764. If (Mode AND dmLimitLoX <> 0) Then
  5765. P.X := Max(P.X, Limits.A.X); { Left side move }
  5766. If (Mode AND dmLimitLoY <> 0) Then
  5767. P.Y := Max(P.Y, Limits.A.Y); { Top side move }
  5768. If (Mode AND dmLimitHiX <> 0) Then
  5769. P.X := Min(P.X, Limits.B.X - S.X); { Right side move }
  5770. If (Mode AND dmLimitHiY <> 0) Then
  5771. P.Y := Min(P.Y, Limits.B.Y - S.Y); { Bottom side move }
  5772. R.Assign(P.X, P.Y, P.X + S.X, P.Y + S.Y); { Assign area }
  5773. Locate(R); { Locate view }
  5774. END;
  5775. PROCEDURE Change (DX, DY: Integer);
  5776. BEGIN
  5777. If (Mode AND dmDragMove <> 0) AND
  5778. (GetShiftState AND $03 = 0) Then Begin
  5779. Inc(P.X, DX); Inc(P.Y, DY); { Adjust values }
  5780. End Else If (Mode AND dmDragGrow <> 0) AND
  5781. (GetShiftState AND $03 <> 0) Then Begin
  5782. Inc(S.X, DX); Inc(S.Y, DY); { Adjust values }
  5783. End;
  5784. END;
  5785. PROCEDURE Update (X, Y: Integer);
  5786. BEGIN
  5787. If (Mode AND dmDragMove <> 0) Then Begin
  5788. P.X := X; P.Y := Y; { Adjust values }
  5789. End;
  5790. END;
  5791. BEGIN
  5792. SetState(sfDragging, True); { Set drag state }
  5793. If (Event.What = evMouseDown) Then Begin { Mouse down event }
  5794. Q.X := Event.Where.X DIV FontWidth - Origin.X; { Offset mouse x origin }
  5795. Q.Y := Event.Where.Y DIV FontHeight - Origin.Y; { Offset mouse y origin }
  5796. Op1.X := RawOrigin.X; Op1.Y := RawOrigin.Y; { Hold origin point }
  5797. Op2.X := RawOrigin.X+RawSize.X; { Right side x value }
  5798. Op2.Y := RawOrigin.Y+RawSize.Y; { Right side y value }
  5799. PState := State; { Hold current state }
  5800. State := State AND NOT sfVisible; { Temp not visible }
  5801. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5802. HideMouseCursor; { Hide the mouse }
  5803. {$ENDIF}
  5804. SetWriteMode(XORPut, TextModeGFV);
  5805. GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
  5806. SetWriteMode(NormalPut, TextModeGFV);
  5807. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5808. ShowMouseCursor; { Show the mouse }
  5809. {$ENDIF}
  5810. Repeat
  5811. Mouse.X := Round(Event.Where.X/FontWidth)-Q.X; { New x origin point }
  5812. Mouse.Y := Round(Event.Where.Y/FontHeight)-Q.Y;{ New y origin point }
  5813. If (Mode AND dmDragMove<>0) Then Begin
  5814. If (Owner<>Nil) Then Begin
  5815. Dec(Mouse.X, Owner^.Origin.X); { Sub owner x origin }
  5816. Dec(Mouse.Y, Owner^.Origin.Y); { Sub owner y origin }
  5817. End;
  5818. R := Mouse; Mouse := Size; { Exchange values }
  5819. End Else Begin
  5820. R := Origin; { Start at origin }
  5821. If (Owner<>Nil) Then Begin
  5822. Dec(R.X, Owner^.Origin.X); { Sub owner x origin }
  5823. Dec(R.Y, Owner^.Origin.Y); { Sub owner y origin }
  5824. End;
  5825. Mouse.X := Mouse.X+Q.X-Origin.X;
  5826. Mouse.Y := Mouse.Y+Q.Y-Origin.Y;
  5827. End;
  5828. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5829. HideMouseCursor; { Hide the mouse }
  5830. {$ENDIF}
  5831. SetWriteMode(XORPut, TextModeGFV);
  5832. GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
  5833. SetWriteMode(NormalPut, TextModeGFV);
  5834. MoveGrow(R, Mouse); { Resize the view }
  5835. SetWriteMode(XORPut, TextModeGFV);
  5836. GraphRectangle(0, 0, RawSize.X, RawSize.Y, Red);
  5837. SetWriteMode(NormalPut, TextModeGFV);
  5838. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  5839. ShowMouseCursor; { Show the mouse }
  5840. {$ENDIF}
  5841. Until NOT MouseEvent(Event, evMouseMove); { Finished moving }
  5842. State := PState; { Restore view state }
  5843. If (Owner<>Nil) Then
  5844. Owner^.ReDrawArea(Op1.X, Op1.Y, Op2.X, Op2.Y); { Redraw old area }
  5845. SetState(sfDragging, False); { Clr dragging flag }
  5846. DrawView; { Now redraw the view }
  5847. End Else Begin
  5848. GetBounds(SaveBounds); { Get current bounds }
  5849. Repeat
  5850. P := Origin; S := Size; { Set values }
  5851. KeyEvent(Event); { Get key event }
  5852. Case Event.KeyCode AND $FF00 Of
  5853. kbLeft: Change(-1, 0); { Move left }
  5854. kbRight: Change(1, 0); { Move right }
  5855. kbUp: Change(0, -1); { Move up }
  5856. kbDown: Change(0, 1); { Move down }
  5857. kbCtrlLeft: Change(-8, 0);
  5858. kbCtrlRight: Change(8, 0);
  5859. kbHome: Update(Limits.A.X, P.Y);
  5860. kbEnd: Update(Limits.B.X - S.X, P.Y);
  5861. kbPgUp: Update(P.X, Limits.A.Y);
  5862. kbPgDn: Update(P.X, Limits.B.Y - S.Y);
  5863. End;
  5864. MoveGrow(P, S); { Now move the view }
  5865. Until (Event.KeyCode = kbEnter) OR
  5866. (Event.KeyCode = kbEsc);
  5867. If (Event.KeyCode=kbEsc) Then Locate(SaveBounds);{ Restore original }
  5868. End;
  5869. SetState(sfDragging, False); { Clr dragging flag }
  5870. END;
  5871. FUNCTION TView.FontWidth: Integer;
  5872. BEGIN
  5873. FontWidth := SysFontWidth;
  5874. END;
  5875. FUNCTION TView.FontHeight: Integer;
  5876. BEGIN
  5877. FontHeight := SysFontHeight;
  5878. END;
  5879. {$IFNDEF OS_DOS}
  5880. {***************************************************************************}
  5881. { TView OBJECT WIN/NT ONLY METHODS }
  5882. {***************************************************************************}
  5883. {--TView--------------------------------------------------------------------}
  5884. { CreateWindowNow -> Platforms WIN/NT/OS2 - Updated 17Mar98 LdB }
  5885. {---------------------------------------------------------------------------}
  5886. PROCEDURE TView.CreateWindowNow (CmdShow: Integer);
  5887. VAR Li: LongInt; S: String; Cp, Ct: Array[0..256] Of Char;
  5888. {$IFDEF OS_WINDOWS} VAR WndClass: TWndClass; {$ENDIF}
  5889. {$IFDEF OS_OS2} VAR P: Pointer; WndClass: ClassInfo; {$ENDIF}
  5890. BEGIN
  5891. If (HWindow = 0) Then Begin { Window not created }
  5892. S := GetClassName; { Fetch classname }
  5893. FillChar(Cp, SizeOf(Cp), #0); { Clear buffer }
  5894. Move(S[1], Cp, Length(S)); { Transfer classname }
  5895. S := GetClassText; { Fetch class text }
  5896. FillChar(Ct, SizeOf(Ct), #0); { Clear buffer }
  5897. Move(S[1], Ct, Length(S)); { Transfer class text }
  5898. If (GOptions AND goNativeClass = 0) AND { Not native class }
  5899. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  5900. {$IFNDEF PPC_SPEED}
  5901. {$IFDEF PPC_FPC}
  5902. NOT GetClassInfo(HInstance, Cp, @WndClass)
  5903. {$ELSE}
  5904. NOT GetClassInfo(HInstance, Cp, WndClass)
  5905. {$ENDIF}
  5906. {$ELSE} { SPEEDSOFT SYBIL2+ }
  5907. NOT GetClassInfo(0, CString(Cp), WndClass)
  5908. {$ENDIF}
  5909. Then Begin { Class not registered }
  5910. WndClass.Style := CS_HRedraw OR CS_VReDraw OR
  5911. CS_DBLClks; { Class styles }
  5912. {$IFDEF PPC_SPEED}
  5913. WndClass.lpfnWndProc:= WndProc(GetMsgHandler); { Message handler }
  5914. {$ELSE}
  5915. Pointer(WndClass.lpfnWndProc) := GetMsgHandler;{ Message handler }
  5916. {$ENDIF}
  5917. WndClass.cbClsExtra := 0; { No extra data }
  5918. WndClass.cbWndExtra := 0; { No extra data }
  5919. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5920. WndClass.hInstance := 0;
  5921. WndClass.hIcon := Idi_Application; { Set icon }
  5922. {$ELSE}
  5923. WndClass.hInstance := HInstance; { Set instance }
  5924. WndClass.hIcon := LoadIcon(0, Idi_Application);{ Set icon }
  5925. {$ENDIF}
  5926. WndClass.hCursor := LoadCursor(0, Idc_Arrow); { Set cursor }
  5927. WndClass.hbrBackground := GetStockObject(
  5928. Null_Brush); { Class brush }
  5929. WndClass.lpszMenuName := Nil; { No menu }
  5930. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5931. WndClass.lpszClassName := @Cp; { Set class name }
  5932. {$ELSE} { OTHER COMPILERS }
  5933. WndClass.lpszClassName := Cp; { Set class name }
  5934. {$ENDIF}
  5935. {$IFDEF BIT_32} { 32 BIT CODE }
  5936. If (RegisterClass(WndClass) = 0)
  5937. {$ENDIF}
  5938. {$IFDEF BIT_16} { 16 BIT CODE }
  5939. If (RegisterClass(WndClass) = False)
  5940. {$ENDIF}
  5941. Then Begin
  5942. MessageBox(GetFocus, 'Can not Register Class',
  5943. 'UnKnown Error Cause?', mb_OK); { Failed to register }
  5944. Halt; { Halt on failure }
  5945. End;
  5946. End;
  5947. If (GOptions AND goNativeClass <> 0) Then
  5948. Li := 1 Else Li := 0;
  5949. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner window }
  5950. Then HWindow := CreateWindowEx(ExStyle,
  5951. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5952. CString(Cp), Ct, GetClassAttr OR ws_Child,
  5953. RawOrigin.X-Owner^.RawOrigin.X-Owner^.FrameSize,
  5954. RawOrigin.Y-Owner^.RawOrigin.Y-Owner^.CaptSize+Li,
  5955. RawSize.X+1,
  5956. RawSize.Y+1, Owner^.HWindow, GetClassId, 0, Nil)
  5957. {$ELSE}
  5958. Cp, Ct, GetClassAttr OR ws_Child,
  5959. RawOrigin.X-Owner^.RawOrigin.X-Owner^.FrameSize,
  5960. RawOrigin.Y-Owner^.RawOrigin.Y-Owner^.CaptSize+Li,
  5961. RawSize.X+1,
  5962. RawSize.Y+1, Owner^.HWindow, GetClassId, hInstance, Nil)
  5963. {$ENDIF}
  5964. Else HWindow := CreateWindowEx(ExStyle,
  5965. {$IFDEF PPC_SPEED} { SPEEDSOFT SYBIL2+ }
  5966. CString(Cp), Ct, GetClassAttr,
  5967. RawOrigin.X, RawOrigin.Y, RawSize.X+1, RawSize.Y+1,
  5968. AppWindow, GetClassId, 0, Nil); { Create the window }
  5969. {$ELSE}
  5970. Cp, Ct, GetClassAttr,
  5971. RawOrigin.X, RawOrigin.Y, RawSize.X+1, RawSize.Y+1,
  5972. AppWindow, GetClassId, hInstance, Nil); { Create the window }
  5973. {$ENDIF}
  5974. If (HWindow <> 0) Then Begin { Window created ok }
  5975. SendMessage(HWindow, WM_SetFont, DefGFVFont, 1);
  5976. Li := LongInt(@Self); { Address of self }
  5977. {$IFDEF BIT_16} { 16 BIT CODE }
  5978. SetProp(HWindow, ViewSeg, Li AND $FFFF0000
  5979. SHR 16); { Set seg property }
  5980. SetProp(HWindow, ViewOfs, Li AND $FFFF); { Set ofs propertry }
  5981. {$ENDIF}
  5982. {$IFDEF BIT_32} { 32 BIT CODE }
  5983. SetProp(HWindow, ViewPtr, Li ); { Set view property }
  5984. {$ENDIF}
  5985. If (CmdShow <> 0) Then
  5986. ShowWindow(HWindow, cmdShow); { Execute show cmd }
  5987. If (State AND sfVisible <> 0) Then Begin
  5988. UpdateWindow(HWindow); { Update the window }
  5989. BringWindowToTop(HWindow); { Bring window to top }
  5990. End;
  5991. If (State AND sfDisabled <> 0) Then
  5992. EnableWindow(HWindow, False); { Disable the window }
  5993. End;
  5994. {$ENDIF}
  5995. {$IFDEF OS_OS2} { OS2 CODE }
  5996. (WinQueryClassInfo(Anchor, Cp, WndClass) = False)
  5997. Then Begin { Class not registered }
  5998. P := GetMsgHandler; { Message handler }
  5999. If (WinRegisterClass(Anchor, Cp, P,
  6000. cs_SizeRedraw, SizeOf(Pointer))= False) { Register the class }
  6001. Then Begin
  6002. WinMessageBox(0, 0, 'Can not Register Class',
  6003. 'UnKnown Error Cause?', 0, mb_OK); { Failed to register }
  6004. Halt; { Halt on failure }
  6005. End;
  6006. End;
  6007. Li := GetClassAttr; { Class attributes }
  6008. If (Owner <> Nil) AND (Owner^.HWindow <> 0) { Valid owner window }
  6009. Then Begin
  6010. HWindow := WinCreateStdWindow(Owner^.Client,
  6011. 0, Li, Cp, Ct, lStyle, 0, 0, @Client);
  6012. If (HWindow <> 0) Then Begin { Window created ok }
  6013. Li := LongInt(@Self); { Address of self }
  6014. WinSetPresParam(Client, PP_User,
  6015. SizeOf(Pointer), @Li); { Hold as property }
  6016. WinSetWindowPos(HWindow, 0, RawOrigin.X-Owner^.RawOrigin.X,
  6017. (Owner^.RawOrigin.Y + Owner^.RawSize.Y) -
  6018. (RawOrigin.Y + RawSize.Y),
  6019. RawSize.X+1, RawSize.Y+1,
  6020. swp_Move + swp_Size + swp_Activate + swp_Show);
  6021. If (GOptions AND goNativeClass <> 0) Then Begin
  6022. WinSetOwner(Client, Owner^.Client);
  6023. End;
  6024. If (State AND sfDisabled <> 0) Then
  6025. WinEnableWindow(HWindow, False); { Disable the window }
  6026. End;
  6027. End Else Begin
  6028. HWindow := WinCreateStdWindow(HWND_Desktop,
  6029. 0, Li, Cp, Ct, lStyle, 0, 0, @Client);
  6030. If (HWindow <> 0) Then Begin { Window created ok }
  6031. Li := LongInt(@Self); { Address of self }
  6032. WinSetPresParam(Client, PP_User,
  6033. SizeOf(Pointer), @Li); { Hold as property }
  6034. WinSetWindowPos(HWindow, 0, RawOrigin.X,
  6035. WinQuerySysValue(hwnd_Desktop, sv_CyScreen)-RawSize.Y,
  6036. RawSize.X, RawSize.Y,
  6037. swp_Move + swp_Size + swp_Activate OR cmdShow);
  6038. End;
  6039. End;
  6040. {$ENDIF}
  6041. End;
  6042. END;
  6043. {$ENDIF}
  6044. {ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ}
  6045. {Þ TScroller OBJECT METHODS Ý}
  6046. {ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ}
  6047. PROCEDURE TScroller.ScrollDraw;
  6048. VAR D: TPoint;
  6049. BEGIN
  6050. If (HScrollBar<>Nil) Then D.X := HScrollBar^.Value
  6051. Else D.X := 0; { Horz scroll value }
  6052. If (VScrollBar<>Nil) Then D.Y := VScrollBar^.Value
  6053. Else D.Y := 0; { Vert scroll value }
  6054. If (D.X<>Delta.X) OR (D.Y<>Delta.Y) Then Begin { View has moved }
  6055. SetCursor(Cursor.X+Delta.X-D.X,
  6056. Cursor.Y+Delta.Y-D.Y); { Move the cursor }
  6057. Delta := D; { Set new delta }
  6058. If (DrawLock<>0) Then DrawFlag := True { Draw will need draw }
  6059. Else DrawView; { Redraw the view }
  6060. End;
  6061. END;
  6062. PROCEDURE TScroller.SetLimit (X, Y: Integer);
  6063. VAR PState: Word;
  6064. BEGIN
  6065. Limit.X := X; { Hold x limit }
  6066. Limit.Y := Y; { Hold y limit }
  6067. Inc(DrawLock); { Set draw lock }
  6068. If (HScrollBar<>Nil) Then Begin
  6069. PState := HScrollBar^.State; { Hold bar state }
  6070. HScrollBar^.State := PState AND NOT sfVisible; { Temp not visible }
  6071. HScrollBar^.SetParams(HScrollBar^.Value, 0,
  6072. X-Size.X, Size.X-1, HScrollBar^.ArStep); { Set horz scrollbar }
  6073. HScrollBar^.State := PState; { Restore bar state }
  6074. End;
  6075. If (VScrollBar<>Nil) Then Begin
  6076. PState := VScrollBar^.State; { Hold bar state }
  6077. VScrollBar^.State := PState AND NOT sfVisible; { Temp not visible }
  6078. VScrollBar^.SetParams(VScrollBar^.Value, 0,
  6079. Y-Size.Y, Size.Y-1, VScrollBar^.ArStep); { Set vert scrollbar }
  6080. VScrollBar^.State := PState; { Restore bar state }
  6081. End;
  6082. Dec(DrawLock); { Release draw lock }
  6083. CheckDraw; { Check need to draw }
  6084. END;
  6085. {***************************************************************************}
  6086. { TScroller OBJECT PRIVATE METHODS }
  6087. {***************************************************************************}
  6088. PROCEDURE TScroller.CheckDraw;
  6089. BEGIN
  6090. If (DrawLock = 0) AND DrawFlag Then Begin { Clear & draw needed }
  6091. DrawFlag := False; { Clear draw flag }
  6092. DrawView; { Draw now }
  6093. End;
  6094. END;
  6095. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6096. { TGroup OBJECT METHODS }
  6097. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6098. {--TGroup-------------------------------------------------------------------}
  6099. { Lock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
  6100. {---------------------------------------------------------------------------}
  6101. PROCEDURE TGroup.Lock;
  6102. BEGIN
  6103. If (Buffer <> Nil) OR (LockFlag <> 0)
  6104. Then Inc(LockFlag); { Increment count }
  6105. END;
  6106. {--TGroup-------------------------------------------------------------------}
  6107. { UnLock -> Platforms DOS/DPMI/WIN/OS2 - Checked 23Sep97 LdB }
  6108. {---------------------------------------------------------------------------}
  6109. PROCEDURE TGroup.Unlock;
  6110. BEGIN
  6111. If (LockFlag <> 0) Then Begin
  6112. Dec(LockFlag); { Decrement count }
  6113. {If (LockFlag = 0) Then DrawView;} { Lock release draw }
  6114. End;
  6115. END;
  6116. PROCEDURE TWindow.DrawBorder;
  6117. {$IFDEF OS_DOS} VAR Fc, Bc: Byte; X, Y: Integer; S: String;
  6118. ViewPort: ViewPortType; {$ENDIF}
  6119. BEGIN
  6120. {$IFDEF OS_DOS}
  6121. Fc := GetColor(2) AND $0F; { Foreground colour }
  6122. Bc := 9; { Background colour }
  6123. If (Options AND ofFramed<>0) Then Y := 1
  6124. Else Y := 0; { Initial value }
  6125. If (GOptions AND goThickFramed<>0) Then Inc(Y, 3); { Adjust position }
  6126. ClearArea(0, Y, RawSize.X, Y+FontHeight, Bc); { Clear background }
  6127. If (Title<>Nil) AND (GOptions AND goTitled<>0)
  6128. Then Begin { View has a title }
  6129. GetViewSettings(ViewPort, TextModeGFV);
  6130. X := (RawSize.X DIV 2); { Half way point }
  6131. X := X - (Length(Title^)*FontWidth) DIV 2; { Calc start point }
  6132. If (TextModeGFV <> TRUE) Then Begin { GRAPHICS MODE GFV }
  6133. SetColor(Fc);
  6134. OutTextXY(RawOrigin.X+X-ViewPort.X1,
  6135. RawOrigin.Y+Y+1-ViewPort.Y1+2, Title^); { Write the title }
  6136. End Else Begin { LEON??? }
  6137. End;
  6138. End;
  6139. If (Number>0) AND (Number<10) Then Begin { Valid number }
  6140. Str(Number, S); { Make number string }
  6141. If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
  6142. SetColor(GetColor(2) AND $0F);
  6143. OutTextXY(RawOrigin.X+RawSize.X-2*FontWidth-ViewPort.X1,
  6144. RawOrigin.Y+Y+1-ViewPort.Y1+2, S); { Write number }
  6145. End Else Begin { LEON ????? }
  6146. End;
  6147. End;
  6148. If (Flags AND wfClose<>0) Then Begin { Close icon request }
  6149. If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
  6150. SetColor(Fc);
  6151. OutTextXY(RawOrigin.X+Y+FontWidth-ViewPort.X1,
  6152. RawOrigin.Y+Y+1-ViewPort.Y1+2, '[*]'); { Write close icon }
  6153. End Else Begin { LEON??? }
  6154. End;
  6155. End;
  6156. If (Flags AND wfZoom<>0) Then Begin
  6157. If (TextModeGFV <> True) Then Begin { GRAPHICS MODE GFV }
  6158. SetColor(GetColor(2) AND $0F);
  6159. OutTextXY(RawOrigin.X+RawSize.X-4*FontWidth-Y-ViewPort.X1,
  6160. RawOrigin.Y+Y+1-ViewPort.Y1+2, '['+#24+']'); { Write zoom icon }
  6161. End Else Begin { LEON??? }
  6162. End;
  6163. End;
  6164. BiColorRectangle(Y+1, Y+1, RawSize.X-Y-1, Y+FontHeight,
  6165. White, DarkGray, False); { Draw 3d effect }
  6166. BiColorRectangle(Y+1, Y+1, RawSize.X-Y-2, Y+FontHeight-1,
  6167. White, DarkGray, False); { Draw 3d effect }
  6168. Inherited DrawBorder;
  6169. {$ENDIF}
  6170. END;
  6171. {***************************************************************************}
  6172. { INTERFACE ROUTINES }
  6173. {***************************************************************************}
  6174. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6175. { WINDOW MESSAGE ROUTINES }
  6176. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6177. {---------------------------------------------------------------------------}
  6178. { Message -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  6179. {---------------------------------------------------------------------------}
  6180. FUNCTION Message (Receiver: PView; What, Command: Word;
  6181. InfoPtr: Pointer): Pointer;
  6182. VAR Event: TEvent;
  6183. BEGIN
  6184. Message := Nil; { Preset nil }
  6185. If (Receiver <> Nil) Then Begin { Valid receiver }
  6186. Event.What := What; { Set what }
  6187. Event.Command := Command; { Set command }
  6188. Event.Id := 0; { Zero id field }
  6189. Event.Data := 0; { Zero data field }
  6190. Event.InfoPtr := InfoPtr; { Set info ptr }
  6191. Receiver^.HandleEvent(Event); { Pass to handler }
  6192. If (Event.What = evNothing) Then
  6193. Message := Event.InfoPtr; { Return handler }
  6194. End;
  6195. END;
  6196. {---------------------------------------------------------------------------}
  6197. { NewMessage -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 19Sep97 LdB }
  6198. {---------------------------------------------------------------------------}
  6199. FUNCTION NewMessage (P: PView; What, Command: Word; Id: Integer;
  6200. Data: Real; InfoPtr: Pointer): Pointer;
  6201. VAR Event: TEvent;
  6202. BEGIN
  6203. NewMessage := Nil; { Preset failure }
  6204. If (P <> Nil) Then Begin
  6205. Event.What := What; { Set what }
  6206. Event.Command := Command; { Set event command }
  6207. Event.Id := Id; { Set up Id }
  6208. Event.Data := Data; { Set up data }
  6209. Event.InfoPtr := InfoPtr; { Set up event ptr }
  6210. P^.HandleEvent(Event); { Send to view }
  6211. If (Event.What = evNothing) Then
  6212. NewMessage := Event.InfoPtr; { Return handler }
  6213. End;
  6214. END;
  6215. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6216. { NEW VIEW ROUTINES }
  6217. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6218. {---------------------------------------------------------------------------}
  6219. { CreateIdScrollBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Checked 22May97 LdB }
  6220. {---------------------------------------------------------------------------}
  6221. FUNCTION CreateIdScrollBar (X, Y, Size, Id: Integer; Horz: Boolean): PScrollBar;
  6222. VAR R: TRect; P: PScrollBar;
  6223. BEGIN
  6224. If Horz Then R.Assign(X, Y, X+Size, Y+1) Else { Horizontal bar }
  6225. R.Assign(X, Y, X+1, Y+Size); { Vertical bar }
  6226. P := New(PScrollBar, Init(R)); { Create scrollbar }
  6227. If (P <> Nil) Then Begin
  6228. P^.Id := Id; { Set scrollbar id }
  6229. P^.Options := P^.Options OR ofPostProcess; { Set post processing }
  6230. End;
  6231. CreateIdScrollBar := P; { Return scrollbar }
  6232. END;
  6233. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6234. { OBJECT REGISTRATION PROCEDURES }
  6235. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  6236. {---------------------------------------------------------------------------}
  6237. { RegisterViews -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May97 LdB }
  6238. {---------------------------------------------------------------------------}
  6239. PROCEDURE RegisterViews;
  6240. BEGIN
  6241. RegisterType(RView); { Register views }
  6242. RegisterType(RFrame); { Register frame }
  6243. RegisterType(RScrollBar); { Register scrollbar }
  6244. RegisterType(RScroller); { Register scroller }
  6245. RegisterType(RListViewer); { Register listview }
  6246. RegisterType(RGroup); { Register group }
  6247. RegisterType(RWindow); { Register window }
  6248. END;
  6249. END.
  6250. {
  6251. $Log$
  6252. Revision 1.4 2001-04-10 21:57:56 pierre
  6253. + first adds for Use_API define
  6254. Revision 1.3 2001/04/10 21:29:55 pierre
  6255. * import of Leon de Boer's files
  6256. Revision 1.2 2000/08/24 12:00:22 marco
  6257. * CVS log and ID tags
  6258. }