dialogs.pas 192 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270
  1. { $Id$ }
  2. {********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
  3. { }
  4. { System independent GRAPHICAL clone of DIALOGS.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 addr }
  10. { [email protected] - backup e-mail addr }
  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. { }
  25. { Only Free Pascal Compiler supported }
  26. { }
  27. {**********************************************************}
  28. UNIT Dialogs;
  29. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  30. INTERFACE
  31. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  32. {====Include file to sort compiler platform out =====================}
  33. {$I Platform.inc}
  34. {====================================================================}
  35. {==== Compiler directives ===========================================}
  36. {$X+} { Extended syntax is ok }
  37. {$R-} { Disable range checking }
  38. {$S-} { Disable Stack Checking }
  39. {$I-} { Disable IO Checking }
  40. {$Q-} { Disable Overflow Checking }
  41. {$V-} { Turn off strict VAR strings }
  42. {====================================================================}
  43. USES
  44. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  45. Windows, { Standard units }
  46. {$ENDIF}
  47. {$IFDEF OS_OS2} { OS2 CODE }
  48. {$IFDEF PPC_FPC}
  49. OS2Def, DosCalls, PMWIN, { Standard units }
  50. {$ELSE}
  51. OS2Def, OS2Base, OS2PMAPI, { Standard units }
  52. {$ENDIF}
  53. {$ENDIF}
  54. GFVGraph, { GFV standard unit }
  55. FVCommon, FVConsts, Objects, Drivers, Views, Validate; { Standard GFV units }
  56. {***************************************************************************}
  57. { PUBLIC CONSTANTS }
  58. {***************************************************************************}
  59. {---------------------------------------------------------------------------}
  60. { COLOUR PALETTE DEFINITIONS }
  61. {---------------------------------------------------------------------------}
  62. CONST
  63. CGrayDialog = #32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47 +
  64. #48#49#50#51#52#53#54#55#56#57#58#59#60#61#62#63;
  65. CBlueDialog = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79 +
  66. #80#81#82#83#84#85#86#87#88#89#90#91#92#92#94#95;
  67. CCyanDialog = #96#97#98#99#100#101#102#103#104#105#106#107#108 +
  68. #109#110#111#112#113#114#115#116#117#118#119#120 +
  69. #121#122#123#124#125#126#127;
  70. CStaticText = #6#7#8#9;
  71. CLabel = #7#8#9#9;
  72. CButton = #10#11#12#13#14#14#14#15;
  73. CCluster = #16#17#18#18#31#6;
  74. CInputLine = #19#19#20#21#14;
  75. CHistory = #22#23;
  76. CHistoryWindow = #19#19#21#24#25#19#20;
  77. CHistoryViewer = #6#6#7#6#6;
  78. CDialog = CGrayDialog; { Default palette }
  79. const
  80. { ldXXXX constants }
  81. ldNone = $0000;
  82. ldNew = $0001;
  83. ldEdit = $0002;
  84. ldDelete = $0004;
  85. ldNewEditDelete = ldNew or ldEdit or ldDelete;
  86. ldHelp = $0008;
  87. ldAllButtons = ldNew or ldEdit or ldDelete or ldHelp;
  88. ldNewIcon = $0010;
  89. ldEditIcon = $0020;
  90. ldDeleteIcon = $0040;
  91. ldAllIcons = ldNewIcon or ldEditIcon or ldDeleteIcon;
  92. ldAll = ldAllIcons or ldAllButtons;
  93. ldNoFrame = $0080;
  94. ldNoScrollBar = $0100;
  95. { ofXXXX constants }
  96. ofNew = $0001;
  97. ofDelete = $0002;
  98. ofEdit = $0004;
  99. ofNewEditDelete = ofNew or ofDelete or ofEdit;
  100. {---------------------------------------------------------------------------}
  101. { TDialog PALETTE COLOUR CONSTANTS }
  102. {---------------------------------------------------------------------------}
  103. CONST
  104. dpBlueDialog = 0; { Blue dialog colour }
  105. dpCyanDialog = 1; { Cyan dialog colour }
  106. dpGrayDialog = 2; { Gray dialog colour }
  107. {---------------------------------------------------------------------------}
  108. { TButton FLAGS MASKS }
  109. {---------------------------------------------------------------------------}
  110. CONST
  111. bfNormal = $00; { Normal displayed }
  112. bfDefault = $01; { Default command }
  113. bfLeftJust = $02; { Left just text }
  114. bfBroadcast = $04; { Broadcast command }
  115. bfGrabFocus = $08; { Grab focus }
  116. {---------------------------------------------------------------------------}
  117. { TMultiCheckBoxes FLAGS - (HiByte = Bits LoByte = Mask) }
  118. {---------------------------------------------------------------------------}
  119. CONST
  120. cfOneBit = $0101; { One bit masks }
  121. cfTwoBits = $0203; { Two bit masks }
  122. cfFourBits = $040F; { Four bit masks }
  123. cfEightBits = $08FF; { Eight bit masks }
  124. {---------------------------------------------------------------------------}
  125. { DIALOG BROADCAST COMMANDS }
  126. {---------------------------------------------------------------------------}
  127. CONST
  128. cmRecordHistory = 60; { Record history cmd }
  129. {***************************************************************************}
  130. { RECORD DEFINITIONS }
  131. {***************************************************************************}
  132. {---------------------------------------------------------------------------}
  133. { ITEM RECORD DEFINITION }
  134. {---------------------------------------------------------------------------}
  135. TYPE
  136. PSItem = ^TSItem;
  137. TSItem = RECORD
  138. Value: PString; { Item string }
  139. Next: PSItem; { Next item }
  140. END;
  141. {***************************************************************************}
  142. { OBJECT DEFINITIONS }
  143. {***************************************************************************}
  144. {---------------------------------------------------------------------------}
  145. { TInputLine OBJECT - INPUT LINE OBJECT }
  146. {---------------------------------------------------------------------------}
  147. TYPE
  148. TInputLine = OBJECT (TView)
  149. MaxLen: Sw_Integer; { Max input length }
  150. CurPos: Sw_Integer; { Cursor position }
  151. FirstPos: Sw_Integer; { First position }
  152. SelStart: Sw_Integer; { Selected start }
  153. SelEnd: Sw_Integer; { Selected end }
  154. Data: PString; { Input line data }
  155. Validator: PValidator; { Validator of view }
  156. CONSTRUCTOR Init (Var Bounds: TRect; AMaxLen: Sw_Integer);
  157. CONSTRUCTOR Load (Var S: TStream);
  158. DESTRUCTOR Done; Virtual;
  159. FUNCTION DataSize: Sw_Word; Virtual;
  160. FUNCTION GetPalette: PPalette; Virtual;
  161. FUNCTION Valid (Command: Word): Boolean; Virtual;
  162. PROCEDURE Draw; Virtual;
  163. PROCEDURE DrawCursor; Virtual;
  164. PROCEDURE DrawbackGround; Virtual;
  165. PROCEDURE SelectAll (Enable: Boolean);
  166. PROCEDURE SetValidator (AValid: PValidator);
  167. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  168. PROCEDURE GetData (Var Rec); Virtual;
  169. PROCEDURE SetData (Var Rec); Virtual;
  170. PROCEDURE Store (Var S: TStream);
  171. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  172. PRIVATE
  173. FUNCTION CanScroll (Delta: Sw_Integer): Boolean;
  174. END;
  175. PInputLine = ^TInputLine;
  176. {---------------------------------------------------------------------------}
  177. { TButton OBJECT - BUTTON ANCESTOR OBJECT }
  178. {---------------------------------------------------------------------------}
  179. TYPE
  180. TButton = OBJECT (TView)
  181. AmDefault: Boolean; { If default button }
  182. Flags : Byte; { Button flags }
  183. Command : Word; { Button command }
  184. Title : PString; { Button title }
  185. CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ACommand: Word;
  186. AFlags: Word);
  187. CONSTRUCTOR Load (Var S: TStream);
  188. DESTRUCTOR Done; Virtual;
  189. FUNCTION GetPalette: PPalette; Virtual;
  190. PROCEDURE Press; Virtual;
  191. PROCEDURE DrawFocus; Virtual;
  192. PROCEDURE DrawState (Down: Boolean);
  193. PROCEDURE MakeDefault (Enable: Boolean);
  194. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  195. PROCEDURE Store (Var S: TStream);
  196. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  197. PRIVATE
  198. DownFlag: Boolean;
  199. END;
  200. PButton = ^TButton;
  201. {---------------------------------------------------------------------------}
  202. { TCluster OBJECT - CLUSTER ANCESTOR OBJECT }
  203. {---------------------------------------------------------------------------}
  204. TYPE
  205. { Palette layout }
  206. { 1 = Normal text }
  207. { 2 = Selected text }
  208. { 3 = Normal shortcut }
  209. { 4 = Selected shortcut }
  210. { 5 = Disabled text }
  211. TCluster = OBJECT (TView)
  212. Id : Sw_Integer; { New communicate id }
  213. Sel : Sw_Integer; { Selected item }
  214. Value : LongInt; { Bit value }
  215. EnableMask: LongInt; { Mask enable bits }
  216. Strings : TStringCollection; { String collection }
  217. CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem);
  218. CONSTRUCTOR Load (Var S: TStream);
  219. DESTRUCTOR Done; Virtual;
  220. FUNCTION DataSize: Sw_Word; Virtual;
  221. FUNCTION GetHelpCtx: Word; Virtual;
  222. FUNCTION GetPalette: PPalette; Virtual;
  223. FUNCTION Mark (Item: Sw_Integer): Boolean; Virtual;
  224. FUNCTION MultiMark (Item: Sw_Integer): Byte; Virtual;
  225. FUNCTION ButtonState (Item: Sw_Integer): Boolean;
  226. PROCEDURE DrawFocus; Virtual;
  227. PROCEDURE Press (Item: Sw_Integer); Virtual;
  228. PROCEDURE MovedTo (Item: Sw_Integer); Virtual;
  229. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  230. PROCEDURE DrawMultiBox (Const Icon, Marker: String);
  231. PROCEDURE DrawBox (Const Icon: String; Marker: Char);
  232. PROCEDURE SetButtonState (AMask: Longint; Enable: Boolean);
  233. PROCEDURE GetData (Var Rec); Virtual;
  234. PROCEDURE SetData (Var Rec); Virtual;
  235. PROCEDURE Store (Var S: TStream);
  236. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  237. PRIVATE
  238. FUNCTION FindSel (P: TPoint): Sw_Integer;
  239. FUNCTION Row (Item: Sw_Integer): Sw_Integer;
  240. FUNCTION Column (Item: Sw_Integer): Sw_Integer;
  241. END;
  242. PCluster = ^TCluster;
  243. {---------------------------------------------------------------------------}
  244. { TRadioButtons OBJECT - RADIO BUTTON OBJECT }
  245. {---------------------------------------------------------------------------}
  246. { Palette layout }
  247. { 1 = Normal text }
  248. { 2 = Selected text }
  249. { 3 = Normal shortcut }
  250. { 4 = Selected shortcut }
  251. TYPE
  252. TRadioButtons = OBJECT (TCluster)
  253. FUNCTION Mark (Item: Sw_Integer): Boolean; Virtual;
  254. PROCEDURE DrawFocus; Virtual;
  255. PROCEDURE Press (Item: Sw_Integer); Virtual;
  256. PROCEDURE MovedTo(Item: Sw_Integer); Virtual;
  257. PROCEDURE SetData (Var Rec); Virtual;
  258. END;
  259. PRadioButtons = ^TRadioButtons;
  260. {---------------------------------------------------------------------------}
  261. { TCheckBoxes OBJECT - CHECK BOXES OBJECT }
  262. {---------------------------------------------------------------------------}
  263. { Palette layout }
  264. { 1 = Normal text }
  265. { 2 = Selected text }
  266. { 3 = Normal shortcut }
  267. { 4 = Selected shortcut }
  268. TYPE
  269. TCheckBoxes = OBJECT (TCluster)
  270. FUNCTION Mark (Item: Sw_Integer): Boolean; Virtual;
  271. PROCEDURE DrawFocus; Virtual;
  272. PROCEDURE Press (Item: Sw_Integer); Virtual;
  273. END;
  274. PCheckBoxes = ^TCheckBoxes;
  275. {---------------------------------------------------------------------------}
  276. { TMultiCheckBoxes OBJECT - CHECK BOXES OBJECT }
  277. {---------------------------------------------------------------------------}
  278. { Palette layout }
  279. { 1 = Normal text }
  280. { 2 = Selected text }
  281. { 3 = Normal shortcut }
  282. { 4 = Selected shortcut }
  283. TYPE
  284. TMultiCheckBoxes = OBJECT (TCluster)
  285. SelRange: Byte; { Select item range }
  286. Flags : Word; { Select flags }
  287. States : PString; { Strings }
  288. CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem;
  289. ASelRange: Byte; AFlags: Word; Const AStates: String);
  290. CONSTRUCTOR Load (Var S: TStream);
  291. DESTRUCTOR Done; Virtual;
  292. FUNCTION DataSize: Sw_Word; Virtual;
  293. FUNCTION MultiMark (Item: Sw_Integer): Byte; Virtual;
  294. PROCEDURE DrawFocus; Virtual;
  295. PROCEDURE Press (Item: Sw_Integer); Virtual;
  296. PROCEDURE GetData (Var Rec); Virtual;
  297. PROCEDURE SetData (Var Rec); Virtual;
  298. PROCEDURE Store (Var S: TStream);
  299. END;
  300. PMultiCheckBoxes = ^TMultiCheckBoxes;
  301. {---------------------------------------------------------------------------}
  302. { TListBox OBJECT - LIST BOX OBJECT }
  303. {---------------------------------------------------------------------------}
  304. { Palette layout }
  305. { 1 = Active }
  306. { 2 = Inactive }
  307. { 3 = Focused }
  308. { 4 = Selected }
  309. { 5 = Divider }
  310. TYPE
  311. TListBox = OBJECT (TListViewer)
  312. List: PCollection; { List of strings }
  313. CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Sw_Word;
  314. AScrollBar: PScrollBar);
  315. CONSTRUCTOR Load (Var S: TStream);
  316. FUNCTION DataSize: Sw_Word; Virtual;
  317. FUNCTION GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
  318. PROCEDURE NewList(AList: PCollection); Virtual;
  319. PROCEDURE GetData (Var Rec); Virtual;
  320. PROCEDURE SetData (Var Rec); Virtual;
  321. PROCEDURE Store (Var S: TStream);
  322. procedure DeleteFocusedItem; virtual;
  323. { DeleteFocusedItem deletes the focused item and redraws the view. }
  324. {#X FreeFocusedItem }
  325. procedure DeleteItem (Item : Sw_Integer); virtual;
  326. { DeleteItem deletes Item from the associated collection. }
  327. {#X FreeItem }
  328. procedure FreeAll; virtual;
  329. { FreeAll deletes and disposes of all items in the associated
  330. collection. }
  331. { FreeFocusedItem FreeItem }
  332. procedure FreeFocusedItem; virtual;
  333. { FreeFocusedItem deletes and disposes of the focused item then redraws
  334. the listbox. }
  335. {#X FreeAll FreeItem }
  336. procedure FreeItem (Item : Sw_Integer); virtual;
  337. { FreeItem deletes Item from the associated collection and disposes of
  338. it, then redraws the listbox. }
  339. {#X FreeFocusedItem FreeAll }
  340. function GetFocusedItem : Pointer; virtual;
  341. { GetFocusedItem is a more readable method of returning the focused
  342. item from the listbox. It is however slightly slower than: }
  343. {#M+}
  344. {
  345. Item := ListBox^.List^.At(ListBox^.Focused); }
  346. {#M-}
  347. procedure Insert (Item : Pointer); virtual;
  348. { Insert inserts Item into the collection, adjusts the listbox's range,
  349. then redraws the listbox. }
  350. {#X FreeItem }
  351. procedure SetFocusedItem (Item : Pointer); virtual;
  352. { SetFocusedItem changes the focused item to Item then redraws the
  353. listbox. }
  354. {# FocusItemNum }
  355. END;
  356. PListBox = ^TListBox;
  357. {---------------------------------------------------------------------------}
  358. { TStaticText OBJECT - STATIC TEXT OBJECT }
  359. {---------------------------------------------------------------------------}
  360. TYPE
  361. TStaticText = OBJECT (TView)
  362. Text: PString; { Text string ptr }
  363. CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String);
  364. CONSTRUCTOR Load (Var S: TStream);
  365. DESTRUCTOR Done; Virtual;
  366. FUNCTION GetPalette: PPalette; Virtual;
  367. PROCEDURE DrawBackGround; Virtual;
  368. PROCEDURE Store (Var S: TStream);
  369. PROCEDURE GetText (Var S: String); Virtual;
  370. END;
  371. PStaticText = ^TStaticText;
  372. {---------------------------------------------------------------------------}
  373. { TParamText OBJECT - PARMETER STATIC TEXT OBJECT }
  374. {---------------------------------------------------------------------------}
  375. { Palette layout }
  376. { 1 = Text }
  377. TYPE
  378. TParamText = OBJECT (TStaticText)
  379. ParamCount: Sw_Integer; { Parameter count }
  380. ParamList : Pointer; { Parameter list }
  381. CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String;
  382. AParamCount: Sw_Integer);
  383. CONSTRUCTOR Load (Var S: TStream);
  384. FUNCTION DataSize: Sw_Word; Virtual;
  385. PROCEDURE GetData (Var Rec); Virtual;
  386. PROCEDURE SetData (Var Rec); Virtual;
  387. PROCEDURE Store (Var S: TStream);
  388. PROCEDURE GetText (Var S: String); Virtual;
  389. END;
  390. PParamText = ^TParamText;
  391. {---------------------------------------------------------------------------}
  392. { TLabel OBJECT - LABEL OBJECT }
  393. {---------------------------------------------------------------------------}
  394. TYPE
  395. TLabel = OBJECT (TStaticText)
  396. Light: Boolean;
  397. Link: PView; { Linked view }
  398. CONSTRUCTOR Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
  399. CONSTRUCTOR Load (Var S: TStream);
  400. FUNCTION GetPalette: PPalette; Virtual;
  401. PROCEDURE DrawBackGround; Virtual;
  402. PROCEDURE Store (Var S: TStream);
  403. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  404. END;
  405. PLabel = ^TLabel;
  406. {---------------------------------------------------------------------------}
  407. { THistoryViewer OBJECT - HISTORY VIEWER OBJECT }
  408. {---------------------------------------------------------------------------}
  409. { Palette layout }
  410. { 1 = Active }
  411. { 2 = Inactive }
  412. { 3 = Focused }
  413. { 4 = Selected }
  414. { 5 = Divider }
  415. TYPE
  416. THistoryViewer = OBJECT (TListViewer)
  417. HistoryId: Word; { History id }
  418. CONSTRUCTOR Init(Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  419. AHistoryId: Word);
  420. FUNCTION HistoryWidth: Sw_Integer;
  421. FUNCTION GetPalette: PPalette; Virtual;
  422. FUNCTION GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
  423. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  424. END;
  425. PHistoryViewer = ^THistoryViewer;
  426. {---------------------------------------------------------------------------}
  427. { THistoryWindow OBJECT - HISTORY WINDOW OBJECT }
  428. {---------------------------------------------------------------------------}
  429. { Palette layout }
  430. { 1 = Frame passive }
  431. { 2 = Frame active }
  432. { 3 = Frame icon }
  433. { 4 = ScrollBar page area }
  434. { 5 = ScrollBar controls }
  435. { 6 = HistoryViewer normal text }
  436. { 7 = HistoryViewer selected text }
  437. TYPE
  438. THistoryWindow = OBJECT (TWindow)
  439. Viewer: PListViewer; { List viewer object }
  440. CONSTRUCTOR Init (Var Bounds: TRect; HistoryId: Word);
  441. FUNCTION GetSelection: String; Virtual;
  442. FUNCTION GetPalette: PPalette; Virtual;
  443. PROCEDURE InitViewer (HistoryId: Word); Virtual;
  444. END;
  445. PHistoryWindow = ^THistoryWindow;
  446. {---------------------------------------------------------------------------}
  447. { THistory OBJECT - HISTORY OBJECT }
  448. {---------------------------------------------------------------------------}
  449. { Palette layout }
  450. { 1 = Arrow }
  451. { 2 = Sides }
  452. TYPE
  453. THistory = OBJECT (TView)
  454. HistoryId: Word;
  455. Link: PInputLine;
  456. CONSTRUCTOR Init (Var Bounds: TRect; ALink: PInputLine; AHistoryId: Word);
  457. CONSTRUCTOR Load (Var S: TStream);
  458. FUNCTION GetPalette: PPalette; Virtual;
  459. FUNCTION InitHistoryWindow (Var Bounds: TRect): PHistoryWindow; Virtual;
  460. PROCEDURE Draw; Virtual;
  461. PROCEDURE RecordHistory (CONST S: String); Virtual;
  462. PROCEDURE Store (Var S: TStream);
  463. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  464. END;
  465. PHistory = ^THistory;
  466. {#Z+}
  467. PBrowseInputLine = ^TBrowseInputLine;
  468. TBrowseInputLine = Object(TInputLine)
  469. History: Sw_Word;
  470. constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer; AHistory: Sw_Word);
  471. constructor Load(var S: TStream);
  472. function DataSize: Sw_Word; virtual;
  473. procedure GetData(var Rec); virtual;
  474. procedure SetData(var Rec); virtual;
  475. procedure Store(var S: TStream);
  476. end; { of TBrowseInputLine }
  477. TBrowseInputLineRec = record
  478. Text: string;
  479. History: Sw_Word;
  480. end; { of TBrowseInputLineRec }
  481. {#Z+}
  482. PBrowseButton = ^TBrowseButton;
  483. {#Z-}
  484. TBrowseButton = Object(TButton)
  485. Link: PBrowseInputLine;
  486. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ACommand: Word;
  487. AFlags: Byte; ALink: PBrowseInputLine);
  488. constructor Load(var S: TStream);
  489. procedure Press; virtual;
  490. procedure Store(var S: TStream);
  491. end; { of TBrowseButton }
  492. {#Z+}
  493. PCommandIcon = ^TCommandIcon;
  494. {#Z-}
  495. TCommandIcon = Object(TStaticText)
  496. { A TCommandIcon sends an evCommand message to its owner with
  497. Event.Command set to #Command# when it is clicked with a mouse. }
  498. constructor Init (var Bounds : TRect; AText : String; ACommand : Word);
  499. { Creates an instance of a TCommandIcon and sets #Command# to
  500. ACommand. AText is the text which is displayed as the icon. If an
  501. error occurs Init fails. }
  502. procedure HandleEvent (var Event : TEvent); virtual;
  503. { Captures mouse events within its borders and sends an evCommand to
  504. its owner in response to the mouse event. }
  505. {#X Command }
  506. private
  507. Command : Word;
  508. { Command is the command sent to the command icon's owner when it is
  509. clicked. }
  510. end; { of TCommandIcon }
  511. {#Z+}
  512. PCommandSItem = ^TCommandSItem;
  513. {#Z-}
  514. TCommandSItem = record
  515. { A TCommandSItem is the data structure used to initialize command
  516. clusters with #NewCommandSItem# rather than the standarad #NewSItem#.
  517. It is used to associate a command with an individual cluster item. }
  518. {#X TCommandCheckBoxes TCommandRadioButtons }
  519. Value : String;
  520. { Value is the text displayed for the cluster item. }
  521. {#X Command Next }
  522. Command : Word;
  523. { Command is the command broadcast when the cluster item is pressed. }
  524. {#X Value Next }
  525. Next : PCommandSItem;
  526. { Next is a pointer to the next item in the cluster. }
  527. {#X Value Command }
  528. end; { of TCommandSItem }
  529. TCommandArray = array[0..15] of Word;
  530. { TCommandArray holds a list of commands which are associated with a
  531. cluster. }
  532. {#X TCommandCheckBoxes TCommandRadioButtons }
  533. {#Z+}
  534. PCommandCheckBoxes = ^TCommandCheckBoxes;
  535. {#Z-}
  536. TCommandCheckBoxes = Object(TCheckBoxes)
  537. { TCommandCheckBoxes function as normal TCheckBoxes, except that when a
  538. cluster item is pressed it broadcasts a command associated with the
  539. cluster item to the cluster's owner.
  540. TCommandCheckBoxes are useful when other parts of a dialog should be
  541. enabled or disabled in response to a check box's status. }
  542. CommandList : TCommandArray;
  543. { CommandList is the list of commands associated with each check box
  544. item. }
  545. {#X Init Load Store }
  546. constructor Init (var Bounds : TRect; ACommandStrings : PCommandSItem);
  547. { Init calls the inherited constructor, then sets up the #CommandList#
  548. with the specified commands. If an error occurs Init fails. }
  549. {#X NewCommandSItem }
  550. constructor Load (var S : TStream);
  551. { Load calls the inherited constructor, then loads the #CommandList#
  552. from the stream S. If an error occurs Load fails. }
  553. {#X Store Init }
  554. procedure Press (Item : Sw_Integer); virtual;
  555. { Press calls the inherited Press then broadcasts the command
  556. associated with the cluster item that was pressed to the check boxes'
  557. owner. }
  558. {#X CommandList }
  559. procedure Store (var S : TStream); { store should never be virtual;}
  560. { Store calls the inherited Store method then writes the #CommandList#
  561. to the stream. }
  562. {#X Load }
  563. end; { of TCommandCheckBoxes }
  564. {#Z+}
  565. PCommandRadioButtons = ^TCommandRadioButtons;
  566. {#Z-}
  567. TCommandRadioButtons = Object(TRadioButtons)
  568. { TCommandRadioButtons function as normal TRadioButtons, except that when
  569. a cluster item is pressed it broadcasts a command associated with the
  570. cluster item to the cluster's owner.
  571. TCommandRadioButtons are useful when other parts of a dialog should be
  572. enabled or disabled in response to a radiobutton's status. }
  573. CommandList : TCommandArray; { commands for each possible value }
  574. { The list of commands associated with each radio button item. }
  575. {#X Init Load Store }
  576. constructor Init (var Bounds : TRect; ACommandStrings : PCommandSItem);
  577. { Init calls the inherited constructor and sets up the #CommandList#
  578. with the specified commands. If an error occurs Init disposes of the
  579. command strings then fails. }
  580. {#X NewCommandSItem }
  581. constructor Load (var S : TStream);
  582. { Load calls the inherited constructor then loads the #CommandList#
  583. from the stream S. If an error occurs Load fails. }
  584. {#X Store }
  585. procedure MovedTo (Item : Sw_Integer); virtual;
  586. { MovedTo calls the inherited MoveTo, then broadcasts the command of
  587. the newly selected cluster item to the cluster's owner. }
  588. {#X Press CommandList }
  589. procedure Press (Item : Sw_Integer); virtual;
  590. { Press calls the inherited Press then broadcasts the command
  591. associated with the cluster item that was pressed to the check boxes
  592. owner. }
  593. {#X CommandList MovedTo }
  594. procedure Store (var S : TStream); { store should never be virtual;}
  595. { Store calls the inherited Store method then writes the #CommandList#
  596. to the stream. }
  597. {#X Load }
  598. end; { of TCommandRadioButtons }
  599. PEditListBox = ^TEditListBox;
  600. TEditListBox = Object(TListBox)
  601. CurrentField : Integer;
  602. constructor Init (Bounds : TRect; ANumCols: Word;
  603. AVScrollBar : PScrollBar);
  604. constructor Load (var S : TStream);
  605. function FieldValidator : PValidator; virtual;
  606. function FieldWidth : Integer; virtual;
  607. procedure GetField (InputLine : PInputLine); virtual;
  608. function GetPalette : PPalette; virtual;
  609. procedure HandleEvent (var Event : TEvent); virtual;
  610. procedure SetField (InputLine : PInputLine); virtual;
  611. function StartColumn : Integer; virtual;
  612. PRIVATE
  613. procedure EditField (var Event : TEvent);
  614. end; { of TEditListBox }
  615. PModalInputLine = ^TModalInputLine;
  616. TModalInputLine = Object(TInputLine)
  617. function Execute : Word; virtual;
  618. procedure HandleEvent (var Event : TEvent); virtual;
  619. procedure SetState (AState : Word; Enable : Boolean); virtual;
  620. private
  621. EndState : Word;
  622. end; { of TModalInputLine }
  623. {---------------------------------------------------------------------------}
  624. { TDialog OBJECT - DIALOG OBJECT }
  625. {---------------------------------------------------------------------------}
  626. { Palette layout }
  627. { 1 = Frame passive }
  628. { 2 = Frame active }
  629. { 3 = Frame icon }
  630. { 4 = ScrollBar page area }
  631. { 5 = ScrollBar controls }
  632. { 6 = StaticText }
  633. { 7 = Label normal }
  634. { 8 = Label selected }
  635. { 9 = Label shortcut }
  636. { 10 = Button normal }
  637. { 11 = Button default }
  638. { 12 = Button selected }
  639. { 13 = Button disabled }
  640. { 14 = Button shortcut }
  641. { 15 = Button shadow }
  642. { 16 = Cluster normal }
  643. { 17 = Cluster selected }
  644. { 18 = Cluster shortcut }
  645. { 19 = InputLine normal text }
  646. { 20 = InputLine selected text }
  647. { 21 = InputLine arrows }
  648. { 22 = History arrow }
  649. { 23 = History sides }
  650. { 24 = HistoryWindow scrollbar page area }
  651. { 25 = HistoryWindow scrollbar controls }
  652. { 26 = ListViewer normal }
  653. { 27 = ListViewer focused }
  654. { 28 = ListViewer selected }
  655. { 29 = ListViewer divider }
  656. { 30 = InfoPane }
  657. { 31 = Cluster disabled }
  658. { 32 = Reserved }
  659. PDialog = ^TDialog;
  660. TDialog = object(TWindow)
  661. constructor Init(var Bounds: TRect; ATitle: TTitleStr);
  662. constructor Load(var S: TStream);
  663. procedure Cancel (ACommand : Word); virtual;
  664. { If the dialog is a modal dialog, Cancel calls EndModal(ACommand). If
  665. the dialog is non-modal Cancel calls Close.
  666. Cancel may be overridden to provide special processing prior to
  667. destructing the dialog. }
  668. procedure ChangeTitle (ANewTitle : TTitleStr); virtual;
  669. { ChangeTitle disposes of the current title, assigns ANewTitle to Title,
  670. then redraws the dialog. }
  671. procedure FreeSubView (ASubView : PView); virtual;
  672. { FreeSubView deletes and disposes ASubView from the dialog. }
  673. {#X FreeAllSubViews IsSubView }
  674. procedure FreeAllSubViews; virtual;
  675. { Deletes then disposes all subviews in the dialog. }
  676. {#X FreeSubView IsSubView }
  677. function GetPalette: PPalette; virtual;
  678. procedure HandleEvent(var Event: TEvent); virtual;
  679. function IsSubView (AView : PView) : Boolean; virtual;
  680. { IsSubView returns True if AView is non-nil and is a subview of the
  681. dialog. }
  682. {#X FreeSubView FreeAllSubViews }
  683. function NewButton (X, Y, W, H : Sw_Integer; ATitle : TTitleStr;
  684. ACommand, AHelpCtx : Word;
  685. AFlags : Byte) : PButton;
  686. { Creates and inserts into the dialog a new TButton with the
  687. help context AHelpCtx.
  688. A pointer to the new button is returned for checking validity of the
  689. initialization. }
  690. {#X NewInputLine NewLabel }
  691. function NewLabel (X, Y : Sw_Integer; AText : String;
  692. ALink : PView) : PLabel;
  693. { NewLabel creates and inserts into the dialog a new TLabel and
  694. associates it with ALink. }
  695. {#X NewButton NewInputLine }
  696. function NewInputLine (X, Y, W, AMaxLen : Sw_Integer; AHelpCtx : Word
  697. ; AValidator : PValidator) : PInputLine;
  698. { NewInputLine creates and inserts into the dialog a new TBSDInputLine
  699. with the help context to AHelpCtx and the validator AValidator.
  700. A pointer to the inputline is returned for checking validity of the
  701. initialization. }
  702. {#X NewButton NewLabel }
  703. function Valid(Command: Word): Boolean; virtual;
  704. end;
  705. PListDlg = ^TListDlg;
  706. TListDlg = object(TDialog)
  707. { TListDlg displays a listbox of items, with optional New, Edit, and
  708. Delete buttons displayed according to the options bit set in the
  709. dialog. Use the ofXXXX flags declared in this unit OR'd with the
  710. standard ofXXXX flags to set the appropriate bits in Options.
  711. If enabled, when the New or Edit buttons are pressed, an evCommand
  712. message is sent to the application with a Command value of NewCommand
  713. or EditCommand, respectively. Using this mechanism in combination with
  714. the declared Init parameters, a standard TListDlg can be used with any
  715. type of list displayable in a TListBox or its descendant. }
  716. NewCommand: Word;
  717. EditCommand: Word;
  718. ListBox: PListBox;
  719. ldOptions: Word;
  720. constructor Init (ATitle: TTitleStr; Items: string; AButtons: Word;
  721. AListBox: PListBox; AEditCommand, ANewCommand: Word);
  722. constructor Load(var S: TStream);
  723. procedure HandleEvent(var Event: TEvent); virtual;
  724. procedure Store(var S: TStream); { store should never be virtual;}
  725. end; { of TListDlg }
  726. {***************************************************************************}
  727. { INTERFACE ROUTINES }
  728. {***************************************************************************}
  729. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  730. { ITEM STRING ROUTINES }
  731. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  732. {-NewSItem-----------------------------------------------------------
  733. Allocates memory for a new TSItem record and sets the text field
  734. and chains to the next TSItem. This allows easy construction of
  735. singly-linked lists of strings, to end a chain the next TSItem
  736. should be nil.
  737. 28Apr98 LdB
  738. ---------------------------------------------------------------------}
  739. FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;
  740. { NewCommandSItem allocates and returns a pointer to a new #TCommandSItem#
  741. record. The Value and Next fields of the record are set to NewStr(Str)
  742. and ANext, respectively. The NewSItem function and the TSItem record type
  743. allow easy construction of singly-linked lists of command strings. }
  744. function NewCommandSItem (Str : String; ACommand : Word;
  745. ANext : PCommandSItem) : PCommandSItem;
  746. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  747. { DIALOG OBJECT REGISTRATION PROCEDURE }
  748. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  749. {-RegisterDialogs----------------------------------------------------
  750. This registers all the view type objects used in this unit.
  751. 30Sep99 LdB
  752. ---------------------------------------------------------------------}
  753. PROCEDURE RegisterDialogs;
  754. {***************************************************************************}
  755. { STREAM REGISTRATION RECORDS }
  756. {***************************************************************************}
  757. {---------------------------------------------------------------------------}
  758. { TDialog STREAM REGISTRATION }
  759. {---------------------------------------------------------------------------}
  760. CONST
  761. RDialog: TStreamRec = (
  762. ObjType: 10; { Register id = 10 }
  763. VmtLink: TypeOf(TDialog);
  764. Load: @TDialog.Load; { Object load method }
  765. Store: @TDialog.Store { Object store method }
  766. );
  767. {---------------------------------------------------------------------------}
  768. { TInputLine STREAM REGISTRATION }
  769. {---------------------------------------------------------------------------}
  770. CONST
  771. RInputLine: TStreamRec = (
  772. ObjType: 11; { Register id = 11 }
  773. VmtLink: TypeOf(TInputLine);
  774. Load: @TInputLine.Load; { Object load method }
  775. Store: @TInputLine.Store { Object store method }
  776. );
  777. {---------------------------------------------------------------------------}
  778. { TButton STREAM REGISTRATION }
  779. {---------------------------------------------------------------------------}
  780. CONST
  781. RButton: TStreamRec = (
  782. ObjType: 12; { Register id = 12 }
  783. VmtLink: TypeOf(TButton);
  784. Load: @TButton.Load; { Object load method }
  785. Store: @TButton.Store { Object store method }
  786. );
  787. {---------------------------------------------------------------------------}
  788. { TCluster STREAM REGISTRATION }
  789. {---------------------------------------------------------------------------}
  790. CONST
  791. RCluster: TStreamRec = (
  792. ObjType: 13; { Register id = 13 }
  793. VmtLink: TypeOf(TCluster);
  794. Load: @TCluster.Load; { Object load method }
  795. Store: @TCluster.Store { Objects store method }
  796. );
  797. {---------------------------------------------------------------------------}
  798. { TRadioButtons STREAM REGISTRATION }
  799. {---------------------------------------------------------------------------}
  800. CONST
  801. RRadioButtons: TStreamRec = (
  802. ObjType: 14; { Register id = 14 }
  803. VmtLink: TypeOf(TRadioButtons);
  804. Load: @TRadioButtons.Load; { Object load method }
  805. Store: @TRadioButtons.Store { Object store method }
  806. );
  807. {---------------------------------------------------------------------------}
  808. { TCheckBoxes STREAM REGISTRATION }
  809. {---------------------------------------------------------------------------}
  810. CONST
  811. RCheckBoxes: TStreamRec = (
  812. ObjType: 15; { Register id = 15 }
  813. VmtLink: TypeOf(TCheckBoxes);
  814. Load: @TCheckBoxes.Load; { Object load method }
  815. Store: @TCheckBoxes.Store { Object store method }
  816. );
  817. {---------------------------------------------------------------------------}
  818. { TMultiCheckBoxes STREAM REGISTRATION }
  819. {---------------------------------------------------------------------------}
  820. CONST
  821. RMultiCheckBoxes: TStreamRec = (
  822. ObjType: 27; { Register id = 27 }
  823. VmtLink: TypeOf(TMultiCheckBoxes);
  824. Load: @TMultiCheckBoxes.Load; { Object load method }
  825. Store: @TMultiCheckBoxes.Store { Object store method }
  826. );
  827. {---------------------------------------------------------------------------}
  828. { TListBox STREAM REGISTRATION }
  829. {---------------------------------------------------------------------------}
  830. CONST
  831. RListBox: TStreamRec = (
  832. ObjType: 16; { Register id = 16 }
  833. VmtLink: TypeOf(TListBox);
  834. Load: @TListBox.Load; { Object load method }
  835. Store: @TListBox.Store { Object store method }
  836. );
  837. {---------------------------------------------------------------------------}
  838. { TStaticText STREAM REGISTRATION }
  839. {---------------------------------------------------------------------------}
  840. CONST
  841. RStaticText: TStreamRec = (
  842. ObjType: 17; { Register id = 17 }
  843. VmtLink: TypeOf(TStaticText);
  844. Load: @TStaticText.Load; { Object load method }
  845. Store: @TStaticText.Store { Object store method }
  846. );
  847. {---------------------------------------------------------------------------}
  848. { TLabel STREAM REGISTRATION }
  849. {---------------------------------------------------------------------------}
  850. CONST
  851. RLabel: TStreamRec = (
  852. ObjType: 18; { Register id = 18 }
  853. VmtLink: TypeOf(TLabel);
  854. Load: @TLabel.Load; { Object load method }
  855. Store: @TLabel.Store { Object store method }
  856. );
  857. {---------------------------------------------------------------------------}
  858. { THistory STREAM REGISTRATION }
  859. {---------------------------------------------------------------------------}
  860. CONST
  861. RHistory: TStreamRec = (
  862. ObjType: 19; { Register id = 19 }
  863. VmtLink: TypeOf(THistory);
  864. Load: @THistory.Load; { Object load method }
  865. Store: @THistory.Store { Object store method }
  866. );
  867. {---------------------------------------------------------------------------}
  868. { TParamText STREAM REGISTRATION }
  869. {---------------------------------------------------------------------------}
  870. CONST
  871. RParamText: TStreamRec = (
  872. ObjType: 20; { Register id = 20 }
  873. VmtLink: TypeOf(TParamText);
  874. Load: @TParamText.Load; { Object load method }
  875. Store: @TParamText.Store { Object store method }
  876. );
  877. RCommandCheckBoxes : TStreamRec = (
  878. ObjType : idCommandCheckBoxes;
  879. VmtLink : Ofs(TypeOf(TCommandCheckBoxes)^);
  880. Load : @TCommandCheckBoxes.Load;
  881. Store : @TCommandCheckBoxes.Store);
  882. RCommandRadioButtons : TStreamRec = (
  883. ObjType : idCommandRadioButtons;
  884. VmtLink : Ofs(TypeOf(TCommandRadioButtons)^);
  885. Load : @TCommandRadioButtons.Load;
  886. Store : @TCommandRadioButtons.Store);
  887. RCommandIcon : TStreamRec = (
  888. ObjType : idCommandIcon;
  889. VmtLink : Ofs(Typeof(TCommandIcon)^);
  890. Load : @TCommandIcon.Load;
  891. Store : @TCommandIcon.Store);
  892. RBrowseButton: TStreamRec = (
  893. ObjType : idBrowseButton;
  894. VmtLink : Ofs(TypeOf(TBrowseButton)^);
  895. Load : @TBrowseButton.Load;
  896. Store : @TBrowseButton.Store);
  897. REditListBox : TStreamRec = (
  898. ObjType : idEditListBox;
  899. VmtLink : Ofs(TypeOf(TEditListBox)^);
  900. Load : @TEditListBox.Load;
  901. Store : @TEditListBox.Store);
  902. RListDlg : TStreamRec = (
  903. ObjType : idListDlg;
  904. VmtLink : Ofs(TypeOf(TListDlg)^);
  905. Load : @TListDlg.Load;
  906. Store : @TListDlg.Store);
  907. RModalInputLine : TStreamRec = (
  908. ObjType : idModalInputLine;
  909. VmtLink : Ofs(TypeOf(TModalInputLine)^);
  910. Load : @TModalInputLine.Load;
  911. Store : @TModalInputLine.Store);
  912. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  913. IMPLEMENTATION
  914. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  915. USES App,HistList; { Standard GFV unit }
  916. {***************************************************************************}
  917. { PRIVATE DEFINED CONSTANTS }
  918. {***************************************************************************}
  919. {---------------------------------------------------------------------------}
  920. { LEFT AND RIGHT ARROW CHARACTER CONSTANTS }
  921. {---------------------------------------------------------------------------}
  922. CONST LeftArr = #17; RightArr = #16;
  923. {---------------------------------------------------------------------------}
  924. { TButton MESSAGES }
  925. {---------------------------------------------------------------------------}
  926. CONST
  927. cmGrabDefault = 61; { Grab default }
  928. cmReleaseDefault = 62; { Release default }
  929. {---------------------------------------------------------------------------}
  930. { IsBlank -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
  931. {---------------------------------------------------------------------------}
  932. FUNCTION IsBlank (Ch: Char): Boolean;
  933. BEGIN
  934. IsBlank := (Ch = ' ') OR (Ch = #13) OR (Ch = #10); { Check for characters }
  935. END;
  936. {---------------------------------------------------------------------------}
  937. { HotKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
  938. {---------------------------------------------------------------------------}
  939. FUNCTION HotKey (Const S: String): Char;
  940. VAR I: Sw_Word;
  941. BEGIN
  942. HotKey := #0; { Preset fail }
  943. If (S <> '') Then Begin { Valid string }
  944. I := Pos('~', S); { Search for tilde }
  945. If (I <> 0) Then HotKey := UpCase(S[I+1]); { Return hotkey }
  946. End;
  947. END;
  948. {***************************************************************************}
  949. { OBJECT METHODS }
  950. {***************************************************************************}
  951. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  952. { TDialog OBJECT METHODS }
  953. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  954. {--TDialog------------------------------------------------------------------}
  955. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  956. {---------------------------------------------------------------------------}
  957. CONSTRUCTOR TDialog.Init (Var Bounds: TRect; ATitle: TTitleStr);
  958. BEGIN
  959. Inherited Init(Bounds, ATitle, wnNoNumber); { Call ancestor }
  960. Options := Options OR ofVersion20; { Version two dialog }
  961. GrowMode := 0; { Clear grow mode }
  962. Flags := wfMove + wfClose; { Close/moveable flags }
  963. Palette := dpGrayDialog; { Default gray colours }
  964. END;
  965. {--TDialog------------------------------------------------------------------}
  966. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  967. {---------------------------------------------------------------------------}
  968. CONSTRUCTOR TDialog.Load (Var S: TStream);
  969. BEGIN
  970. Inherited Load(S); { Call ancestor }
  971. If (Options AND ofVersion = ofVersion10) Then Begin
  972. Palette := dpGrayDialog; { Set gray palette }
  973. Options := Options OR ofVersion20; { Update version flag }
  974. End;
  975. END;
  976. {--TDialog------------------------------------------------------------------}
  977. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  978. {---------------------------------------------------------------------------}
  979. FUNCTION TDialog.GetPalette: PPalette;
  980. CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
  981. (CBlueDialog, CCyanDialog, CGrayDialog); { Always normal string }
  982. BEGIN
  983. GetPalette := @P[Palette]; { Return palette }
  984. END;
  985. {--TDialog------------------------------------------------------------------}
  986. { Valid -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 25Apr98 LdB }
  987. {---------------------------------------------------------------------------}
  988. FUNCTION TDialog.Valid (Command: Word): Boolean;
  989. BEGIN
  990. If (Command = cmCancel) Then Valid := True { Cancel returns true }
  991. Else Valid := TGroup.Valid(Command); { Call group ancestor }
  992. END;
  993. {--TDialog------------------------------------------------------------------}
  994. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  995. {---------------------------------------------------------------------------}
  996. PROCEDURE TDialog.HandleEvent (Var Event: TEvent);
  997. BEGIN
  998. Inherited HandleEvent(Event); { Call ancestor }
  999. Case Event.What Of
  1000. evNothing: Exit; { Speed up exit }
  1001. evKeyDown: { Key down event }
  1002. Case Event.KeyCode Of
  1003. kbEsc: Begin { Escape key press }
  1004. Event.What := evCommand; { Command event }
  1005. Event.Command := cmCancel; { cancel command }
  1006. Event.InfoPtr := Nil; { Clear info ptr }
  1007. PutEvent(Event); { Put event on queue }
  1008. ClearEvent(Event); { Clear the event }
  1009. End;
  1010. kbEnter: Begin { Enter key press }
  1011. Event.What := evBroadcast; { Broadcast event }
  1012. Event.Command := cmDefault; { Default command }
  1013. Event.InfoPtr := Nil; { Clear info ptr }
  1014. PutEvent(Event); { Put event on queue }
  1015. ClearEvent(Event); { Clear the event }
  1016. End;
  1017. End;
  1018. evCommand: { Command event }
  1019. Case Event.Command Of
  1020. cmOk, cmCancel, cmYes, cmNo: { End dialog cmds }
  1021. If (State AND sfModal <> 0) Then Begin { View is modal }
  1022. EndModal(Event.Command); { End modal state }
  1023. ClearEvent(Event); { Clear the event }
  1024. End;
  1025. End;
  1026. End;
  1027. END;
  1028. {****************************************************************************}
  1029. { TDialog.Cancel }
  1030. {****************************************************************************}
  1031. procedure TDialog.Cancel (ACommand : Word);
  1032. begin
  1033. if State and sfModal = sfModal then
  1034. EndModal(ACommand)
  1035. else Close;
  1036. end;
  1037. {****************************************************************************}
  1038. { TDialog.ChangeTitle }
  1039. {****************************************************************************}
  1040. procedure TDialog.ChangeTitle (ANewTitle : TTitleStr);
  1041. begin
  1042. if (Title <> nil) then
  1043. DisposeStr(Title);
  1044. Title := NewStr(ANewTitle);
  1045. Frame^.DrawView;
  1046. end;
  1047. {****************************************************************************}
  1048. { TDialog.FreeSubView }
  1049. {****************************************************************************}
  1050. procedure TDialog.FreeSubView (ASubView : PView);
  1051. begin
  1052. if IsSubView(ASubView) then begin
  1053. Delete(ASubView);
  1054. Dispose(ASubView,Done);
  1055. DrawView;
  1056. end;
  1057. end;
  1058. {****************************************************************************}
  1059. { TDialog.FreeAllSubViews }
  1060. {****************************************************************************}
  1061. procedure TDialog.FreeAllSubViews;
  1062. var
  1063. P : PView;
  1064. begin
  1065. P := First;
  1066. repeat
  1067. P := First;
  1068. if (P <> nil) then begin
  1069. Delete(P);
  1070. Dispose(P,Done);
  1071. end;
  1072. until (P = nil);
  1073. DrawView;
  1074. end;
  1075. {****************************************************************************}
  1076. { TDialog.IsSubView }
  1077. {****************************************************************************}
  1078. function TDialog.IsSubView (AView : PView) : Boolean;
  1079. var P : PView;
  1080. begin
  1081. P := First;
  1082. while (P <> nil) and (P <> AView) do
  1083. P := P^.NextView;
  1084. IsSubView := ((P <> nil) and (P = AView));
  1085. end;
  1086. {****************************************************************************}
  1087. { TDialog.NewButton }
  1088. {****************************************************************************}
  1089. function TDialog.NewButton (X, Y, W, H : Sw_Integer; ATitle : TTitleStr;
  1090. ACommand, AHelpCtx : Word;
  1091. AFlags : Byte) : PButton;
  1092. var
  1093. B : PButton;
  1094. R : TRect;
  1095. begin
  1096. R.Assign(X,Y,X+W,Y+H);
  1097. B := New(PButton,Init(R,ATitle,ACommand,AFlags));
  1098. if (B <> nil) then begin
  1099. B^.HelpCtx := AHelpCtx;
  1100. Insert(B);
  1101. end;
  1102. NewButton := B;
  1103. end;
  1104. {****************************************************************************}
  1105. { TDialog.NewInputLine }
  1106. {****************************************************************************}
  1107. function TDialog.NewInputLine (X, Y, W, AMaxLen : Sw_Integer; AHelpCtx : Word
  1108. ; AValidator : PValidator) : PInputLine;
  1109. var
  1110. P : PInputLine;
  1111. R : TRect;
  1112. begin
  1113. R.Assign(X,Y,X+W,Y+1);
  1114. P := New(PInputLine,Init(R,AMaxLen));
  1115. if (P <> nil) then begin
  1116. P^.SetValidator(AValidator);
  1117. P^.HelpCtx := AHelpCtx;
  1118. Insert(P);
  1119. end;
  1120. NewInputLine := P;
  1121. end;
  1122. {****************************************************************************}
  1123. { TDialog.NewLabel }
  1124. {****************************************************************************}
  1125. function TDialog.NewLabel (X, Y : Sw_Integer; AText : String;
  1126. ALink : PView) : PLabel;
  1127. var
  1128. P : PLabel;
  1129. R : TRect;
  1130. begin
  1131. R.Assign(X,Y,X+CStrLen(AText)+1,Y+1);
  1132. P := New(PLabel,Init(R,AText,ALink));
  1133. if (P <> nil) then
  1134. Insert(P);
  1135. NewLabel := P;
  1136. end;
  1137. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1138. { TInputLine OBJECT METHODS }
  1139. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1140. {--TInputLine---------------------------------------------------------------}
  1141. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1142. {---------------------------------------------------------------------------}
  1143. CONSTRUCTOR TInputLine.Init (Var Bounds: TRect; AMaxLen: Sw_Integer);
  1144. BEGIN
  1145. Inherited Init(Bounds); { Call ancestor }
  1146. State := State OR sfCursorVis; { Cursor visible }
  1147. Options := Options OR (ofSelectable + ofFirstClick
  1148. + ofVersion20); { Set options }
  1149. If (MaxAvail > AMaxLen + 1) Then Begin { Check enough memory }
  1150. GetMem(Data, AMaxLen + 1); { Allocate memory }
  1151. Data^ := ''; { Data = empty string }
  1152. End;
  1153. MaxLen := AMaxLen; { Hold maximum length }
  1154. END;
  1155. {--TInputLine---------------------------------------------------------------}
  1156. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1157. {---------------------------------------------------------------------------}
  1158. CONSTRUCTOR TInputLine.Load (Var S: TStream);
  1159. VAR B: Byte;
  1160. W: Word;
  1161. BEGIN
  1162. Inherited Load(S); { Call ancestor }
  1163. S.Read(W, sizeof(w)); MaxLen:=W; { Read max length }
  1164. S.Read(W, sizeof(w)); CurPos:=w; { Read cursor position }
  1165. S.Read(W, sizeof(w)); FirstPos:=w; { Read first position }
  1166. S.Read(W, sizeof(w)); SelStart:=w; { Read selected start }
  1167. S.Read(W, sizeof(w)); SelEnd:=w; { Read selected end }
  1168. S.Read(B, SizeOf(B)); { Read string length }
  1169. If (MaxAvail > MaxLen+1) Then Begin { Check enough memory }
  1170. GetMem(Data, MaxLen + 1); { Allocate memory }
  1171. S.Read(Data^[1], Length(Data^)); { Read string data }
  1172. SetLength(Data^, B); { Xfer string length }
  1173. End Else S.Seek(S.GetPos + B); { Move to position }
  1174. If (Options AND ofVersion >= ofVersion20) Then { Version 2 or above }
  1175. Validator := PValidator(S.Get); { Get any validator }
  1176. Options := Options OR ofVersion20; { Set version 2 flag }
  1177. END;
  1178. {--TInputLine---------------------------------------------------------------}
  1179. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1180. {---------------------------------------------------------------------------}
  1181. DESTRUCTOR TInputLine.Done;
  1182. BEGIN
  1183. If (Data <> Nil) Then FreeMem(Data, MaxLen + 1); { Release any memory }
  1184. SetValidator(Nil); { Clear any validator }
  1185. Inherited Done; { Call ancestor }
  1186. END;
  1187. {--TInputLine---------------------------------------------------------------}
  1188. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1189. {---------------------------------------------------------------------------}
  1190. FUNCTION TInputLine.DataSize: Sw_Word;
  1191. VAR DSize: Sw_Word;
  1192. BEGIN
  1193. DSize := 0; { Preset zero datasize }
  1194. If (Validator <> Nil) AND (Data <> Nil) Then
  1195. DSize := Validator^.Transfer(Data^, Nil,
  1196. vtDataSize); { Add validator size }
  1197. If (DSize <> 0) Then DataSize := DSize { Use validtor size }
  1198. Else DataSize := MaxLen + 1; { No validator use size }
  1199. END;
  1200. {--TInputLine---------------------------------------------------------------}
  1201. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1202. {---------------------------------------------------------------------------}
  1203. FUNCTION TInputLine.GetPalette: PPalette;
  1204. CONST P: String[Length(CInputLine)] = CInputLine; { Always normal string }
  1205. BEGIN
  1206. GetPalette := @P; { Return palette }
  1207. END;
  1208. {--TInputLine---------------------------------------------------------------}
  1209. { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1210. {---------------------------------------------------------------------------}
  1211. FUNCTION TInputLine.Valid (Command: Word): Boolean;
  1212. FUNCTION AppendError (Validator: PValidator): Boolean;
  1213. BEGIN
  1214. AppendError := False; { Preset false }
  1215. If (Data <> Nil) Then
  1216. With Validator^ Do
  1217. If (Options AND voOnAppend <> 0) AND { Check options }
  1218. (CurPos <> Length(Data^)) AND { Exceeds max length }
  1219. NOT IsValidInput(Data^, True) Then Begin { Check data valid }
  1220. Error; { Call error }
  1221. AppendError := True; { Return true }
  1222. End;
  1223. END;
  1224. BEGIN
  1225. Valid := Inherited Valid(Command); { Call ancestor }
  1226. If (Validator <> Nil) AND (Data <> Nil) AND { Validator present }
  1227. (State AND sfDisabled = 0) Then { Not disabled }
  1228. If (Command = cmValid) Then { Valid command }
  1229. Valid := Validator^.Status = vsOk { Validator result }
  1230. Else If (Command <> cmCancel) Then { Not cancel command }
  1231. If AppendError(Validator) OR { Append any error }
  1232. NOT Validator^.Valid(Data^) Then Begin { Check validator }
  1233. Select; { Reselect view }
  1234. Valid := False; { Return false }
  1235. End;
  1236. END;
  1237. {--TInputLine---------------------------------------------------------------}
  1238. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1239. {---------------------------------------------------------------------------}
  1240. PROCEDURE TInputLine.Draw;
  1241. VAR Color: Byte; X, L, R: Sw_Integer; S, T: String;
  1242. BEGIN
  1243. If (State AND sfFocused = 0) Then Color := 1 { Not focused colour }
  1244. Else Color := 2; { Focused colour }
  1245. If CanScroll(-1) Then WriteStr(0, 0, LeftArr, 4); { Set left scroll mark }
  1246. If CanScroll(1) Then WriteStr(-(RawSize.X + 1 -
  1247. TextWidth(RightArr)), 0, RightArr, 4); { Set right scroll mark }
  1248. If (Data <> Nil) Then S := Copy(Data^, FirstPos+1,
  1249. Length(Data^)-FirstPos) Else S := ''; { Fetch data string }
  1250. X := TextWidth(LeftArr); { left arrow width }
  1251. While (TextWidth(S) > ((RawSize.X+1)-X-TextWidth(
  1252. RightArr))) Do Delete(S, Length(S), 1); { Cut to right length }
  1253. If (State AND sfFocused <> 0) Then Begin
  1254. L := SelStart - FirstPos; { Selected left end }
  1255. R := SelEnd - FirstPos; { Selected right end }
  1256. If (L < 0) Then L := 0; { Fix any negative }
  1257. If (R > Length(S)) Then R := Length(S); { Fix to long case }
  1258. If (L > 0) Then Begin
  1259. T := Copy(S, 1, L); { Unhighlight bit }
  1260. WriteStr(-X, 0, T, Color); { Write string to screen }
  1261. X := X + TextWidth(T); { New x position }
  1262. Delete(S, 1, L); { Reduce string }
  1263. End;
  1264. If (L < R) Then Begin
  1265. T := Copy(S, 1, R-L); { Highlight bit }
  1266. WriteStr(-X, 0, T, 3); { Write string to screen }
  1267. X := X + TextWidth(T); { New x position }
  1268. Delete(S, 1, R-L); { Reduce string }
  1269. End;
  1270. If (Length(S) > 0) Then
  1271. WriteStr(-X, 0, S, Color); { Write string to screen }
  1272. End Else WriteStr(-X, 0, S, Color); { Write string to screen }
  1273. Cursor.X := CurPos - FirstPos + 1; { Update cursor position }
  1274. END;
  1275. {--TInputLine---------------------------------------------------------------}
  1276. { DrawbackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1277. {---------------------------------------------------------------------------}
  1278. PROCEDURE TInputLine.DrawBackGround;
  1279. BEGIN
  1280. Inherited DrawBackGround; { Call ancestor }
  1281. END;
  1282. {--TInputLine---------------------------------------------------------------}
  1283. { DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Oct99 LdB }
  1284. {---------------------------------------------------------------------------}
  1285. PROCEDURE TInputLine.DrawCursor;
  1286. VAR I, X: Sw_Integer; S: String;
  1287. BEGIN
  1288. if (TextModeGFV) then
  1289. begin
  1290. Cursor.Y:=0;
  1291. Cursor.X:=CurPos-FirstPos+1;
  1292. TView.ResetCursor;
  1293. end
  1294. else If (State AND sfFocused <> 0) Then Begin { Focused window }
  1295. X := TextWidth(LeftArr); { Preset x position }
  1296. I := 0; { Preset cursor width }
  1297. If (Data <> Nil) Then Begin { Data pointer valid }
  1298. S := Copy(Data^, FirstPos+1, CurPos-FirstPos); { Copy the string }
  1299. X := X + TextWidth(S); { Calculate position }
  1300. If (State AND sfCursorIns <> 0) Then { Check insert mode }
  1301. If ((CurPos+1) <= Length(Data^)) Then
  1302. I := TextWidth(Data^[CurPos+1]) { Insert caret width }
  1303. Else I := FontWidth; { At end use fontwidth }
  1304. End;
  1305. If (State AND sfCursorIns <> 0) Then Begin { Insert mode }
  1306. If ((CurPos+1) <= Length(Data^)) Then { Not beyond end }
  1307. WriteStr(-X, 0, Data^[CurPos+1], 5) { Create block cursor }
  1308. Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
  1309. End Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
  1310. End;
  1311. END;
  1312. {--TInputLine---------------------------------------------------------------}
  1313. { SelectAll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1314. {---------------------------------------------------------------------------}
  1315. PROCEDURE TInputLine.SelectAll (Enable: Boolean);
  1316. BEGIN
  1317. CurPos := 0; { Cursor to start }
  1318. FirstPos := 0; { First pos to start }
  1319. SelStart := 0; { Selected at start }
  1320. If Enable AND (Data <> Nil) Then
  1321. SelEnd := Length(Data^) Else SelEnd := 0; { Selected which end }
  1322. DrawView; { Now redraw the view }
  1323. END;
  1324. {--TInputLine---------------------------------------------------------------}
  1325. { SetValidator -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1326. {---------------------------------------------------------------------------}
  1327. PROCEDURE TInputLine.SetValidator (AValid: PValidator);
  1328. BEGIN
  1329. If (Validator <> Nil) Then Validator^.Free; { Release validator }
  1330. Validator := AValid; { Set new validator }
  1331. END;
  1332. {--TInputLine---------------------------------------------------------------}
  1333. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1334. {---------------------------------------------------------------------------}
  1335. PROCEDURE TInputLine.SetState (AState: Word; Enable: Boolean);
  1336. BEGIN
  1337. Inherited SetState(AState, Enable); { Call ancestor }
  1338. If (AState = sfSelected) OR ((AState = sfActive)
  1339. AND (State and sfSelected <> 0)) Then
  1340. SelectAll(Enable) Else { Call select all }
  1341. If (AState = sfFocused) Then DrawView; { Redraw for focus }
  1342. END;
  1343. {--TInputLine---------------------------------------------------------------}
  1344. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1345. {---------------------------------------------------------------------------}
  1346. PROCEDURE TInputLine.GetData (Var Rec);
  1347. BEGIN
  1348. If (Data <> Nil) Then Begin { Data ptr valid }
  1349. If (Validator = Nil) OR (Validator^.Transfer(Data^,
  1350. @Rec, vtGetData) = 0) Then Begin { No validator/data }
  1351. FillChar(Rec, DataSize, #0); { Clear the data area }
  1352. Move(Data^, Rec, Length(Data^) + 1); { Transfer our data }
  1353. End;
  1354. End Else FillChar(Rec, DataSize, #0); { Clear the data area }
  1355. END;
  1356. {--TInputLine---------------------------------------------------------------}
  1357. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1358. {---------------------------------------------------------------------------}
  1359. PROCEDURE TInputLine.SetData (Var Rec);
  1360. BEGIN
  1361. If (Data <> Nil) Then Begin { Data ptr valid }
  1362. If (Validator = Nil) OR (Validator^.Transfer(
  1363. Data^, @Rec, vtSetData) = 0) Then { No validator/data }
  1364. Move(Rec, Data^[0], DataSize); { Set our data }
  1365. End;
  1366. SelectAll(True); { Now select all }
  1367. END;
  1368. {--TInputLine---------------------------------------------------------------}
  1369. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1370. {---------------------------------------------------------------------------}
  1371. PROCEDURE TInputLine.Store (Var S: TStream);
  1372. VAR w: Word;
  1373. BEGIN
  1374. TView.Store(S); { Implict TView.Store }
  1375. w:=MaxLen;S.Write(w, SizeOf(w)); { Read max length }
  1376. w:=CurPos;S.Write(w, SizeOf(w)); { Read cursor position }
  1377. w:=FirstPos;S.Write(w, SizeOf(w)); { Read first position }
  1378. w:=SelStart;S.Write(w, SizeOf(w)); { Read selected start }
  1379. w:=SelEnd;S.Write(w, SizeOf(w)); { Read selected end }
  1380. S.WriteStr(Data); { Write the data }
  1381. S.Put(Validator); { Write any validator }
  1382. END;
  1383. {--TInputLine---------------------------------------------------------------}
  1384. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1385. {---------------------------------------------------------------------------}
  1386. PROCEDURE TInputLine.HandleEvent (Var Event: TEvent);
  1387. CONST PadKeys = [$47, $4B, $4D, $4F, $73, $74];
  1388. VAR WasAppending: Boolean; ExtendBlock: Boolean; OldData: String;
  1389. Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Sw_Integer;
  1390. FUNCTION MouseDelta: Sw_Integer;
  1391. BEGIN
  1392. If (Event.Where.X <= RawOrigin.X+TextWidth(LeftArr))
  1393. Then MouseDelta := -1 Else { To left of text area }
  1394. If ((Event.Where.X-RawOrigin.X) >= RawSize.X -
  1395. TextWidth(RightArr)) Then MouseDelta := 1 { To right of text area }
  1396. Else MouseDelta := 0; { In area return 0 }
  1397. END;
  1398. FUNCTION MousePos: Sw_Integer;
  1399. VAR Mp, Tw, Pos: Sw_Integer; S: String;
  1400. BEGIN
  1401. Mp := Event.Where.X - RawOrigin.X; { Mouse position }
  1402. If (Data <> Nil) Then S := Copy(Data^, FirstPos+1,
  1403. Length(Data^)-FirstPos) Else S := ''; { Text area string }
  1404. Tw := TextWidth(LeftArr); { Text width }
  1405. Pos := 0; { Zero position }
  1406. While (Mp > Tw) AND (Pos <= Length(S)) Do Begin { Still text to right }
  1407. Tw := Tw + TextWidth(S[Pos+1]); { Add next character }
  1408. Inc(Pos); { Next character }
  1409. End;
  1410. If (Pos > 0) Then Dec(Pos);
  1411. MousePos := FirstPos + Pos; { Return mouse position }
  1412. END;
  1413. PROCEDURE DeleteSelect;
  1414. BEGIN
  1415. If (SelStart <> SelEnd) Then Begin { An area selected }
  1416. If (Data <> Nil) Then
  1417. Delete(Data^, SelStart+1, SelEnd-SelStart); { Delete the text }
  1418. CurPos := SelStart; { Set cursor position }
  1419. End;
  1420. END;
  1421. PROCEDURE AdjustSelectBlock;
  1422. BEGIN
  1423. If (CurPos < Anchor) Then Begin { Selection backwards }
  1424. SelStart := CurPos; { Start of select }
  1425. SelEnd := Anchor; { End of select }
  1426. End Else Begin
  1427. SelStart := Anchor; { Start of select }
  1428. SelEnd := CurPos; { End of select }
  1429. End;
  1430. END;
  1431. PROCEDURE SaveState;
  1432. BEGIN
  1433. If (Validator <> Nil) Then Begin { Check for validator }
  1434. If (Data <> Nil) Then OldData := Data^; { Hold data }
  1435. OldCurPos := CurPos; { Hold cursor position }
  1436. OldFirstPos := FirstPos; { Hold first position }
  1437. OldSelStart := SelStart; { Hold select start }
  1438. OldSelEnd := SelEnd; { Hold select end }
  1439. If (Data = Nil) Then WasAppending := True { Invalid data ptr }
  1440. Else WasAppending := Length(Data^) = CurPos; { Hold appending state }
  1441. End;
  1442. END;
  1443. PROCEDURE RestoreState;
  1444. BEGIN
  1445. If (Validator <> Nil) Then Begin { Validator valid }
  1446. If (Data <> Nil) Then Data^ := OldData; { Restore data }
  1447. CurPos := OldCurPos; { Restore cursor pos }
  1448. FirstPos := OldFirstPos; { Restore first pos }
  1449. SelStart := OldSelStart; { Restore select start }
  1450. SelEnd := OldSelEnd; { Restore select end }
  1451. End;
  1452. END;
  1453. FUNCTION CheckValid (NoAutoFill: Boolean): Boolean;
  1454. VAR OldLen: Sw_Integer; NewData: String;
  1455. BEGIN
  1456. If (Validator <> Nil) Then Begin { Validator valid }
  1457. CheckValid := False; { Preset false return }
  1458. If (Data <> Nil) Then OldLen := Length(Data^); { Hold old length }
  1459. If (Validator^.Options AND voOnAppend = 0) OR
  1460. (WasAppending AND (CurPos = OldLen)) Then Begin
  1461. If (Data <> Nil) Then NewData := Data^ { Hold current data }
  1462. Else NewData := ''; { Set empty string }
  1463. If NOT Validator^.IsValidInput(NewData,
  1464. NoAutoFill) Then RestoreState Else Begin
  1465. If (Length(NewData) > MaxLen) Then { Exceeds maximum }
  1466. SetLength(NewData, MaxLen); { Set string length }
  1467. If (Data <> Nil) Then Data^ := NewData; { Set data value }
  1468. If (Data <> Nil) AND (CurPos >= OldLen) { Cursor beyond end }
  1469. AND (Length(Data^) > OldLen) Then { Cursor beyond string }
  1470. CurPos := Length(Data^); { Set cursor position }
  1471. CheckValid := True; { Return true result }
  1472. End;
  1473. End Else Begin
  1474. CheckValid := True; { Preset true return }
  1475. If (CurPos = OldLen) AND (Data <> Nil) Then { Lengths match }
  1476. If NOT Validator^.IsValidInput(Data^,
  1477. False) Then Begin { Check validator }
  1478. Validator^.Error; { Call error }
  1479. CheckValid := False; { Return false result }
  1480. End;
  1481. End;
  1482. End Else CheckValid := True; { No validator }
  1483. END;
  1484. BEGIN
  1485. Inherited HandleEvent(Event); { Call ancestor }
  1486. If (State AND sfSelected <> 0) Then Begin { View is selected }
  1487. Case Event.What Of
  1488. evNothing: Exit; { Speed up exit }
  1489. evMouseDown: Begin { Mouse down event }
  1490. Delta := MouseDelta; { Calc scroll value }
  1491. If CanScroll(Delta) Then Begin { Can scroll }
  1492. Repeat
  1493. If CanScroll(Delta) Then Begin { Still can scroll }
  1494. Inc(FirstPos, Delta); { Move start position }
  1495. DrawView; { Redraw the view }
  1496. End;
  1497. Until NOT MouseEvent(Event, evMouseAuto); { Until no mouse auto }
  1498. End Else If Event.Double Then { Double click }
  1499. SelectAll(True) Else Begin { Select whole text }
  1500. Anchor := MousePos; { Start of selection }
  1501. Repeat
  1502. If (Event.What = evMouseAuto) { Mouse auto event }
  1503. Then Begin
  1504. Delta := MouseDelta; { New position }
  1505. If CanScroll(Delta) Then { If can scroll }
  1506. Inc(FirstPos, Delta);
  1507. End;
  1508. CurPos := MousePos; { Set cursor position }
  1509. AdjustSelectBlock; { Adjust selected }
  1510. DrawView; { Redraw the view }
  1511. Until NOT MouseEvent(Event, evMouseMove
  1512. + evMouseAuto); { Until mouse released }
  1513. End;
  1514. ClearEvent(Event); { Clear the event }
  1515. End;
  1516. evKeyDown: Begin
  1517. SaveState; { Save state of view }
  1518. Event.KeyCode := CtrlToArrow(Event.KeyCode); { Convert keycode }
  1519. If (Event.ScanCode IN PadKeys) AND
  1520. (GetShiftState AND $03 <> 0) Then Begin { Mark selection active }
  1521. Event.CharCode := #0; { Clear char code }
  1522. If (CurPos = SelEnd) Then { Find if at end }
  1523. Anchor := SelStart Else { Anchor from start }
  1524. Anchor := SelEnd; { Anchor from end }
  1525. ExtendBlock := True; { Extended block true }
  1526. End Else ExtendBlock := False; { No extended block }
  1527. Case Event.KeyCode Of
  1528. kbLeft: If (CurPos > 0) Then Dec(CurPos); { Move cursor left }
  1529. kbRight: If (Data <> Nil) AND { Move right cursor }
  1530. (CurPos < Length(Data^)) Then Begin { Check not at end }
  1531. Inc(CurPos); { Move cursor }
  1532. CheckValid(True); { Check if valid }
  1533. End;
  1534. kbHome: CurPos := 0; { Move to line start }
  1535. kbEnd: Begin { Move to line end }
  1536. If (Data = Nil) Then CurPos := 0 { Invalid data ptr }
  1537. Else CurPos := Length(Data^); { Set cursor position }
  1538. CheckValid(True); { Check if valid }
  1539. End;
  1540. kbBack: If (Data <> Nil) AND (CurPos > 0) { Not at line start }
  1541. Then Begin
  1542. Delete(Data^, CurPos, 1); { Backspace over char }
  1543. Dec(CurPos); { Move cursor back one }
  1544. If (FirstPos > 0) Then Dec(FirstPos); { Move first position }
  1545. CheckValid(True); { Check if valid }
  1546. End;
  1547. kbDel: If (Data <> Nil) Then Begin { Delete character }
  1548. If (SelStart = SelEnd) Then { Select all on }
  1549. If (CurPos < Length(Data^)) Then Begin { Cursor not at end }
  1550. SelStart := CurPos; { Set select start }
  1551. SelEnd := CurPos + 1; { Set select end }
  1552. End;
  1553. DeleteSelect; { Deselect selection }
  1554. CheckValid(True); { Check if valid }
  1555. End;
  1556. kbIns: SetState(sfCursorIns, State AND
  1557. sfCursorIns = 0); { Flip insert state }
  1558. Else Case Event.CharCode Of
  1559. ' '..#255: If (Data <> Nil) Then Begin { Character key }
  1560. If (State AND sfCursorIns <> 0) Then
  1561. Delete(Data^, CurPos + 1, 1) Else { Overwrite character }
  1562. DeleteSelect; { Deselect selected }
  1563. If CheckValid(True) Then Begin { Check data valid }
  1564. If (Length(Data^) < MaxLen) Then { Must not exceed maxlen }
  1565. Begin
  1566. If (FirstPos > CurPos) Then
  1567. FirstPos := CurPos; { Advance first position }
  1568. Inc(CurPos); { Increment cursor }
  1569. Insert(Event.CharCode, Data^,
  1570. CurPos); { Insert the character }
  1571. End;
  1572. CheckValid(False); { Check data valid }
  1573. End;
  1574. End;
  1575. ^Y: If (Data <> Nil) Then Begin { Clear all data }
  1576. Data^ := ''; { Set empty string }
  1577. CurPos := 0; { Cursor to start }
  1578. End;
  1579. Else Exit; { Unused key }
  1580. End
  1581. End;
  1582. If ExtendBlock Then AdjustSelectBlock { Extended block }
  1583. Else Begin
  1584. SelStart := CurPos; { Set select start }
  1585. SelEnd := CurPos; { Set select end }
  1586. End;
  1587. If (FirstPos > CurPos) Then
  1588. FirstPos := CurPos; { Advance first pos }
  1589. If (Data <> Nil) Then OldData := Copy(Data^,
  1590. FirstPos+1, CurPos-FirstPos) { Text area string }
  1591. Else OldData := ''; { Empty string }
  1592. Delta := FontWidth; { Safety = 1 char }
  1593. While (TextWidth(OldData) > ((RawSize.X+1)-Delta)
  1594. - TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits }
  1595. Do Begin
  1596. Inc(FirstPos); { Advance first pos }
  1597. OldData := Copy(Data^, FirstPos+1,
  1598. CurPos-FirstPos) { Text area string }
  1599. End;
  1600. DrawView; { Redraw the view }
  1601. ClearEvent(Event); { Clear the event }
  1602. End;
  1603. End;
  1604. End;
  1605. END;
  1606. {***************************************************************************}
  1607. { TInputLine OBJECT PRIVATE METHODS }
  1608. {***************************************************************************}
  1609. {--TInputLine---------------------------------------------------------------}
  1610. { CanScroll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1611. {---------------------------------------------------------------------------}
  1612. FUNCTION TInputLine.CanScroll (Delta: Sw_Integer): Boolean;
  1613. VAR S: String;
  1614. BEGIN
  1615. If (Delta < 0) Then CanScroll := FirstPos > 0 { Check scroll left }
  1616. Else If (Delta > 0) Then Begin
  1617. If (Data = Nil) Then S := '' Else { Data ptr invalid }
  1618. S := Copy(Data^, FirstPos+1, Length(Data^)
  1619. - FirstPos); { Fetch max string }
  1620. CanScroll := (TextWidth(S)) > (RawSize.X -
  1621. TextWidth(LeftArr) - TextWidth(RightArr)); { Check scroll right }
  1622. End Else CanScroll := False; { Zero so no scroll }
  1623. END;
  1624. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1625. { TButton OBJECT METHODS }
  1626. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1627. {--TButton------------------------------------------------------------------}
  1628. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1629. {---------------------------------------------------------------------------}
  1630. CONSTRUCTOR TButton.Init (Var Bounds: TRect; ATitle: TTitleStr;
  1631. ACommand: Word; AFlags: Word);
  1632. BEGIN
  1633. Inherited Init(Bounds); { Call ancestor }
  1634. EventMask := EventMask OR evBroadcast; { Handle broadcasts }
  1635. GOptions := GOptions OR goDrawFocus; { Set new option mask }
  1636. Options := Options OR (ofSelectable + ofFirstClick
  1637. + ofPreProcess + ofPostProcess); { Set option flags }
  1638. If NOT CommandEnabled(ACommand) Then
  1639. State := State OR sfDisabled; { Check command state }
  1640. Flags := AFlags; { Hold flags }
  1641. If (AFlags AND bfDefault <> 0) Then AmDefault := True
  1642. Else AmDefault := False; { Check if default }
  1643. Title := NewStr(ATitle); { Hold title string }
  1644. Command := ACommand; { Hold button command }
  1645. TabMask := TabMask OR (tmLeft + tmRight +
  1646. tmTab + tmShiftTab + tmUp + tmDown); { Set tab masks }
  1647. END;
  1648. {--TButton------------------------------------------------------------------}
  1649. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1650. {---------------------------------------------------------------------------}
  1651. CONSTRUCTOR TButton.Load (Var S: TStream);
  1652. BEGIN
  1653. Inherited Load(S); { Call ancestor }
  1654. Title := S.ReadStr; { Read title }
  1655. S.Read(Command, SizeOf(Command)); { Read command }
  1656. S.Read(Flags, SizeOf(Flags)); { Read flags }
  1657. S.Read(AmDefault, SizeOf(AmDefault)); { Read if default }
  1658. If NOT CommandEnabled(Command) Then { Check command state }
  1659. State := State OR sfDisabled Else { Command disabled }
  1660. State := State AND NOT sfDisabled; { Command enabled }
  1661. END;
  1662. {--TButton------------------------------------------------------------------}
  1663. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1664. {---------------------------------------------------------------------------}
  1665. DESTRUCTOR TButton.Done;
  1666. BEGIN
  1667. If (Title <> Nil) Then DisposeStr(Title); { Dispose title }
  1668. Inherited Done; { Call ancestor }
  1669. END;
  1670. {--TButton------------------------------------------------------------------}
  1671. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1672. {---------------------------------------------------------------------------}
  1673. FUNCTION TButton.GetPalette: PPalette;
  1674. CONST P: String[Length(CButton)] = CButton; { Always normal string }
  1675. BEGIN
  1676. GetPalette := @P; { Get button palette }
  1677. END;
  1678. {--TButton------------------------------------------------------------------}
  1679. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Apr98 LdB }
  1680. {---------------------------------------------------------------------------}
  1681. PROCEDURE TButton.Press;
  1682. VAR E: TEvent;
  1683. BEGIN
  1684. Message(Owner, evBroadcast, cmRecordHistory, Nil); { Message for history }
  1685. If (Flags AND bfBroadcast <> 0) Then { Broadcasting button }
  1686. Message(Owner, evBroadcast, Command, @Self) { Send message }
  1687. Else Begin
  1688. E.What := evCommand; { Command event }
  1689. E.Command := Command; { Set command value }
  1690. E.InfoPtr := @Self; { Pointer to self }
  1691. PutEvent(E); { Put event on queue }
  1692. End;
  1693. END;
  1694. {--TButton------------------------------------------------------------------}
  1695. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1696. {---------------------------------------------------------------------------}
  1697. PROCEDURE TButton.DrawFocus;
  1698. VAR B: Byte; I, J, Pos: Sw_Integer;
  1699. Bc: Word; Db: TDrawBuffer;
  1700. StoreUseFixedFont: boolean;
  1701. C : char;
  1702. BEGIN
  1703. If not TextModeGFV then Begin
  1704. If DownFlag Then B := 7 Else B := 0; { Shadow colour }
  1705. GraphRectangle(0, 0, RawSize.X, RawSize.Y, B); { Draw backing shadow }
  1706. GraphRectangle(1, 1, RawSize.X-1, RawSize.Y-1, B); { Draw backing shadow }
  1707. If DownFlag Then B := 0 Else B := 15; { Highlight colour }
  1708. GraphLine(0, RawSize.Y, 0, 0, B);
  1709. GraphLine(1, RawSize.Y-1, 1, 1, B); { Left highlights }
  1710. GraphLine(0, 0, RawSize.X, 0, B);
  1711. GraphLine(1, 1, RawSize.X-1, 1, B); { Top highlights }
  1712. If DownFlag Then B := 8 Else B := 7; { Select backing }
  1713. If (State AND sfFocused <> 0) AND
  1714. (DownFlag = False) Then B := 14; { Show as focused }
  1715. GraphRectangle(2, 2, RawSize.X-2, RawSize.Y-2, B); { Draw first border }
  1716. GraphRectangle(3, 3, RawSize.X-3, RawSize.Y-3, B); { Draw next border }
  1717. End;
  1718. If (State AND sfDisabled <> 0) Then { Button disabled }
  1719. Bc := GetColor($0404) Else Begin { Disabled colour }
  1720. Bc := GetColor($0501); { Set normal colour }
  1721. If (State AND sfActive <> 0) Then { Button is active }
  1722. If (State AND sfSelected <> 0) Then
  1723. Bc := GetColor($0703) Else { Set selected colour }
  1724. If AmDefault Then Bc := GetColor($0602); { Set is default colour }
  1725. End;
  1726. If (Title <> Nil) Then Begin { We have a title }
  1727. If (Flags AND bfLeftJust = 0) Then Begin { Not left set title }
  1728. I := TextWidth(Title^); { Fetch title width }
  1729. I := (RawSize.X - I) DIV 2; { Centre in button }
  1730. End Else I := FontWidth; { Left edge of button }
  1731. If not TextModeGFV then Begin
  1732. MoveCStr(Db[0], Title^, Bc); { Move title to buffer }
  1733. GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
  1734. StoreUseFixedFont:=UseFixedFont;
  1735. UseFixedFont:=false;
  1736. WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
  1737. 1, Db); { Write the title }
  1738. GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
  1739. UseFixedFont:=StoreUseFixedFont;
  1740. End Else Begin
  1741. I:=I div SysFontWidth;
  1742. If DownFlag then
  1743. begin
  1744. MoveChar(Db[0],' ',GetColor(8),1);
  1745. Pos:=1;
  1746. end
  1747. else
  1748. pos:=0;
  1749. For j:=0 to I-1 do
  1750. MoveChar(Db[pos+j],' ',Bc,1);
  1751. MoveCStr(Db[I+pos], Title^, Bc); { Move title to buffer }
  1752. For j:=pos+CStrLen(Title^)+I to size.X-2 do
  1753. MoveChar(Db[j],' ',Bc,1);
  1754. If not DownFlag then
  1755. Bc:=GetColor(8);
  1756. MoveChar(Db[Size.X-1],' ',Bc,1);
  1757. WriteLine(0, 0, Size.X,
  1758. 1, Db); { Write the title }
  1759. If Size.Y>1 then Begin
  1760. Bc:=GetColor(8);
  1761. if not DownFlag then
  1762. begin
  1763. c:='Ü';
  1764. MoveChar(Db,c,Bc,1);
  1765. WriteLine(Size.X-1, 0, 1, 1, Db);
  1766. end;
  1767. MoveChar(Db,' ',Bc,1);
  1768. if DownFlag then c:=' '
  1769. else c:='ß';
  1770. MoveChar(Db[1],c,Bc,Size.X-1);
  1771. WriteLine(0, 1, Size.X, 1, Db);
  1772. End;
  1773. End;
  1774. End;
  1775. END;
  1776. {--TButton------------------------------------------------------------------}
  1777. { DrawState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1778. {---------------------------------------------------------------------------}
  1779. PROCEDURE TButton.DrawState (Down: Boolean);
  1780. BEGIN
  1781. DownFlag := Down; { Set down flag }
  1782. SetDrawMask(vdFocus); { Set focus mask }
  1783. DrawView; { Redraw the view }
  1784. END;
  1785. {--TButton------------------------------------------------------------------}
  1786. { MakeDefault -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1787. {---------------------------------------------------------------------------}
  1788. PROCEDURE TButton.MakeDefault (Enable: Boolean);
  1789. VAR C: Word;
  1790. BEGIN
  1791. If (Flags AND bfDefault=0) Then Begin { Not default }
  1792. If Enable Then C := cmGrabDefault
  1793. Else C := cmReleaseDefault; { Change default }
  1794. Message(Owner, evBroadcast, C, @Self); { Message to owner }
  1795. AmDefault := Enable; { Set default flag }
  1796. DrawView; { Now redraw button }
  1797. End;
  1798. END;
  1799. {--TButton------------------------------------------------------------------}
  1800. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1801. {---------------------------------------------------------------------------}
  1802. PROCEDURE TButton.SetState (AState: Word; Enable: Boolean);
  1803. BEGIN
  1804. Inherited SetState(AState, Enable); { Call ancestor }
  1805. If (AState AND (sfSelected + sfActive) <> 0) { Changing select }
  1806. Then DrawView; { Redraw required }
  1807. If (AState AND sfFocused <> 0) Then
  1808. MakeDefault(Enable); { Check for default }
  1809. END;
  1810. {--TButton------------------------------------------------------------------}
  1811. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  1812. {---------------------------------------------------------------------------}
  1813. PROCEDURE TButton.Store (Var S: TStream);
  1814. BEGIN
  1815. TView.Store(S); { Implict TView.Store }
  1816. S.WriteStr(Title); { Store title string }
  1817. S.Write(Command, SizeOf(Command)); { Store command }
  1818. S.Write(Flags, SizeOf(Flags)); { Store flags }
  1819. S.Write(AmDefault, SizeOf(AmDefault)); { Store default flag }
  1820. END;
  1821. {--TButton------------------------------------------------------------------}
  1822. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
  1823. {---------------------------------------------------------------------------}
  1824. PROCEDURE TButton.HandleEvent (Var Event: TEvent);
  1825. VAR Down: Boolean; C: Char; ButRect: TRect;
  1826. BEGIN
  1827. ButRect.A := RawOrigin; { Get origin point }
  1828. ButRect.B.X := RawOrigin.X + RawSize.X; { Calc right side }
  1829. ButRect.B.Y := RawOrigin.Y + RawSize.Y; { Calc bottom }
  1830. If (Event.What = evMouseDown) Then Begin { Mouse down event }
  1831. If NOT MouseInView(Event.Where) Then Begin { If point not in view }
  1832. ClearEvent(Event); { Clear the event }
  1833. Exit; { Speed up exit }
  1834. End;
  1835. End;
  1836. If (Flags AND bfGrabFocus <> 0) Then { Check focus grab }
  1837. Inherited HandleEvent(Event); { Call ancestor }
  1838. Case Event.What Of
  1839. evNothing: Exit; { Speed up exit }
  1840. evMouseDown: Begin
  1841. If (State AND sfDisabled = 0) Then Begin { Button not disabled }
  1842. Down := False; { Clear down flag }
  1843. Repeat
  1844. If (Down <> ButRect.Contains(Event.Where)) { State has changed }
  1845. Then Begin
  1846. Down := NOT Down; { Invert down flag }
  1847. DrawState(Down); { Redraw button }
  1848. End;
  1849. Until NOT MouseEvent(Event, evMouseMove); { Wait for mouse move }
  1850. If Down Then Begin { Button is down }
  1851. Press; { Send out command }
  1852. DrawState(False); { Draw button up }
  1853. End;
  1854. End;
  1855. ClearEvent(Event); { Event was handled }
  1856. End;
  1857. evKeyDown: Begin
  1858. If (Title <> Nil) Then C := HotKey(Title^) { Key title hotkey }
  1859. Else C := #0; { Invalid title }
  1860. If (Event.KeyCode = GetAltCode(C)) OR { Alt char }
  1861. (Owner^.Phase = phPostProcess) AND (C <> #0)
  1862. AND (Upcase(Event.CharCode) = C) OR { Matches hotkey }
  1863. (State AND sfFocused <> 0) AND { View focused }
  1864. ((Event.CharCode = ' ') OR { Space bar }
  1865. (Event.KeyCode=kbEnter)) Then Begin { Enter key }
  1866. DrawState(True); { Draw button down }
  1867. Press; { Send out command }
  1868. ClearEvent(Event); { Clear the event }
  1869. DrawState(False); { Draw button up }
  1870. End;
  1871. End;
  1872. evBroadcast:
  1873. Case Event.Command of
  1874. cmDefault: If AmDefault AND { Default command }
  1875. (State AND sfDisabled = 0) Then Begin { Button enabled }
  1876. Press; { Send out command }
  1877. ClearEvent(Event); { Clear the event }
  1878. End;
  1879. cmGrabDefault, cmReleaseDefault: { Grab and release cmd }
  1880. If (Flags AND bfDefault <> 0) Then Begin { Change button state }
  1881. AmDefault := Event.Command = cmReleaseDefault;
  1882. DrawView; { Redraw the view }
  1883. End;
  1884. cmCommandSetChanged: Begin { Command set changed }
  1885. SetState(sfDisabled, NOT
  1886. CommandEnabled(Command)); { Set button state }
  1887. DrawView; { Redraw the view }
  1888. End;
  1889. End;
  1890. End;
  1891. END;
  1892. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1893. { TCluster OBJECT METHODS }
  1894. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1895. CONST TvClusterClassName = 'TVCLUSTER';
  1896. {--TCluster-----------------------------------------------------------------}
  1897. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  1898. {---------------------------------------------------------------------------}
  1899. CONSTRUCTOR TCluster.Init (Var Bounds: TRect; AStrings: PSItem);
  1900. VAR I: Sw_Integer; P: PSItem;
  1901. BEGIN
  1902. Inherited Init(Bounds); { Call ancestor }
  1903. GOptions := GOptions OR goDrawFocus; { Draw focus view }
  1904. Options := Options OR (ofSelectable + ofFirstClick
  1905. + ofPreProcess + ofPostProcess + ofVersion20); { Set option masks }
  1906. I := 0; { Zero string count }
  1907. P := AStrings; { First item }
  1908. While (P <> Nil) Do Begin
  1909. Inc(I); { Count 1 item }
  1910. P := P^.Next; { Move to next item }
  1911. End;
  1912. Strings.Init(I, 0); { Create collection }
  1913. While (AStrings <> Nil) Do Begin
  1914. P := AStrings; { Transfer item ptr }
  1915. Strings.AtInsert(Strings.Count, AStrings^.Value);{ Insert string }
  1916. AStrings := AStrings^.Next; { Move to next item }
  1917. Dispose(P); { Dispose prior item }
  1918. End;
  1919. Sel := 0;
  1920. if TextModeGFV then
  1921. begin
  1922. SetCursor(2,0);
  1923. ShowCursor;
  1924. end;
  1925. EnableMask := $FFFFFFFF; { Enable bit masks }
  1926. END;
  1927. {--TCluster-----------------------------------------------------------------}
  1928. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Oct99 LdB }
  1929. {---------------------------------------------------------------------------}
  1930. CONSTRUCTOR TCluster.Load (Var S: TStream);
  1931. VAR w: word;
  1932. BEGIN
  1933. Inherited Load(S); { Call ancestor }
  1934. If ((Options AND ofVersion) >= ofVersion20) Then { Version 2 TV view }
  1935. Begin
  1936. S.Read(Value, SizeOf(Value)); { Read value }
  1937. S.Read(Sel, Sizeof(Sel)); { Read select item }
  1938. S.Read(EnableMask, SizeOf(EnableMask)) { Read enable masks }
  1939. End
  1940. Else
  1941. Begin
  1942. w:=Value;
  1943. S.Read(w, SizeOf(w)); Value:=w; { Read value }
  1944. S.Read(Sel, SizeOf(Sel)); { Read select item }
  1945. EnableMask := $FFFFFFFF; { Enable all masks }
  1946. Options := Options OR ofVersion20; { Set version 2 mask }
  1947. End;
  1948. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  1949. S.Read(Id, Sizeof(Id)); { Read view id }
  1950. Strings.Load(S); { Load string data }
  1951. SetButtonState(0, True); { Set button state }
  1952. END;
  1953. {--TCluster-----------------------------------------------------------------}
  1954. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  1955. {---------------------------------------------------------------------------}
  1956. DESTRUCTOR TCluster.Done;
  1957. VAR I: Sw_Integer;
  1958. BEGIN
  1959. Strings.Done; { Dispose of strings }
  1960. Inherited Done; { Call ancestor }
  1961. END;
  1962. {--TCluster-----------------------------------------------------------------}
  1963. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1964. {---------------------------------------------------------------------------}
  1965. FUNCTION TCluster.DataSize: Sw_Word;
  1966. BEGIN
  1967. DataSize := SizeOf(Sw_Word); { Exchanges a word }
  1968. END;
  1969. {--TCluster-----------------------------------------------------------------}
  1970. { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1971. {---------------------------------------------------------------------------}
  1972. FUNCTION TCluster.GetHelpCtx: Word;
  1973. BEGIN
  1974. If (HelpCtx = hcNoContext) Then { View has no help }
  1975. GetHelpCtx := hcNoContext Else { No help context }
  1976. GetHelpCtx := HelpCtx + Sel; { Help of selected }
  1977. END;
  1978. {--TCluster-----------------------------------------------------------------}
  1979. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1980. {---------------------------------------------------------------------------}
  1981. FUNCTION TCluster.GetPalette: PPalette;
  1982. CONST P: String[Length(CCluster)] = CCluster; { Always normal string }
  1983. BEGIN
  1984. GetPalette := @P; { Cluster palette }
  1985. END;
  1986. {--TCluster-----------------------------------------------------------------}
  1987. { Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  1988. {---------------------------------------------------------------------------}
  1989. FUNCTION TCluster.Mark (Item: Sw_Integer): Boolean;
  1990. BEGIN
  1991. Mark := False; { Default false }
  1992. END;
  1993. {--TCluster-----------------------------------------------------------------}
  1994. { MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  1995. {---------------------------------------------------------------------------}
  1996. FUNCTION TCluster.MultiMark (Item: Sw_Integer): Byte;
  1997. BEGIN
  1998. MultiMark := Byte(Mark(Item) = True); { Return multi mark }
  1999. END;
  2000. {--TCluster-----------------------------------------------------------------}
  2001. { ButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2002. {---------------------------------------------------------------------------}
  2003. FUNCTION TCluster.ButtonState (Item: Sw_Integer): Boolean;
  2004. BEGIN
  2005. If (Item > 31) Then ButtonState := False Else { Impossible item }
  2006. ButtonState := ((1 SHL Item) AND EnableMask)<>0; { Return true/false }
  2007. END;
  2008. {--TCluster-----------------------------------------------------------------}
  2009. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Jul99 LdB }
  2010. {---------------------------------------------------------------------------}
  2011. PROCEDURE TCluster.DrawFocus;
  2012. BEGIN
  2013. END;
  2014. {--TCluster-----------------------------------------------------------------}
  2015. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2016. {---------------------------------------------------------------------------}
  2017. PROCEDURE TCluster.Press (Item: Sw_Integer);
  2018. VAR P: PView;
  2019. BEGIN
  2020. P := TopView;
  2021. If (Id <> 0) AND (P <> Nil) Then NewMessage(P,
  2022. evCommand, cmIdCommunicate, Id, Value, @Self); { Send new message }
  2023. END;
  2024. {--TCluster-----------------------------------------------------------------}
  2025. { MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2026. {---------------------------------------------------------------------------}
  2027. PROCEDURE TCluster.MovedTo (Item: Sw_Integer);
  2028. BEGIN { Abstract method }
  2029. END;
  2030. {--TCluster-----------------------------------------------------------------}
  2031. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2032. {---------------------------------------------------------------------------}
  2033. PROCEDURE TCluster.SetState (AState: Word; Enable: Boolean);
  2034. BEGIN
  2035. Inherited SetState(AState, Enable); { Call ancestor }
  2036. If (AState AND sfFocused <> 0) Then Begin
  2037. SetDrawMask(vdFocus OR vdInner); { Set redraw masks }
  2038. DrawView; { Redraw masked areas }
  2039. End;
  2040. END;
  2041. {--TCluster-----------------------------------------------------------------}
  2042. { DrawMultiBox -> Platforms DOS/DPMI/WIN/NT - Updated 05Jun98 LdB }
  2043. {---------------------------------------------------------------------------}
  2044. PROCEDURE TCluster.DrawMultiBox (Const Icon, Marker: String);
  2045. VAR I, J, K, Cur, Col: Sw_Integer; CNorm, CSel, CDis, Color: Word; B: TDrawBuffer;
  2046. Tb, SCOff: Byte;
  2047. BEGIN
  2048. CNorm := GetColor($0301); { Normal colour }
  2049. CSel := GetColor($0402); { Selected colour }
  2050. CDis := GetColor($0505); { Disabled colour }
  2051. If (Options AND ofFramed <>0) OR { Normal frame }
  2052. (GOptions AND goThickFramed <>0) Then { Thick frame }
  2053. K := 1 Else K := 0; { Select offset }
  2054. For I := 0 To Size.Y-K-K-1 Do Begin { For each line }
  2055. MoveChar(B, ' ', Byte(CNorm), Size.X-K-K); { Fill buffer }
  2056. For J := 0 To (Strings.Count - 1) DIV Size.Y + 1
  2057. Do Begin
  2058. Cur := J*Size.Y + I; { Current line }
  2059. If (Cur < Strings.Count) Then Begin
  2060. Col := Column(Cur); { Calc column }
  2061. If (Col + CStrLen(PString(Strings.At(Cur))^)+
  2062. 5 < Sizeof(TDrawBuffer) DIV SizeOf(Word))
  2063. AND (Col < Size.X-K-K) Then Begin { Text fits in column }
  2064. If NOT ButtonState(Cur) Then
  2065. Color := CDis Else If (Cur = Sel) AND { Disabled colour }
  2066. (State and sfFocused <> 0) Then
  2067. Color := CSel Else { Selected colour }
  2068. Color := CNorm; { Normal colour }
  2069. MoveChar(B[Col], ' ', Byte(Color),
  2070. Size.X-K-K-Col); { Set this colour }
  2071. MoveStr(B[Col], Icon, Byte(Color)); { Transfer icon string }
  2072. WordRec(B[Col+2]).Lo := Byte(Marker[
  2073. MultiMark(Cur) + 1]); { Transfer marker }
  2074. MoveCStr(B[Col+5], PString(Strings.At(
  2075. Cur))^, Color); { Transfer item string }
  2076. If ShowMarkers AND (State AND sfFocused <> 0)
  2077. AND (Cur = Sel) Then Begin { Current is selected }
  2078. WordRec(B[Col]).Lo := Byte(SpecialChars[0]);
  2079. WordRec(B[Column(Cur+Size.Y)-1]).Lo
  2080. := Byte(SpecialChars[1]); { Set special character }
  2081. End;
  2082. End;
  2083. End;
  2084. End;
  2085. WriteBuf(K, K+I, Size.X-K-K, 1, B); { Write buffer }
  2086. End;
  2087. if TextModeGFV then
  2088. SetCursor(Column(Sel)+2,Row(Sel));
  2089. END;
  2090. {--TCluster-----------------------------------------------------------------}
  2091. { DrawBox -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2092. {---------------------------------------------------------------------------}
  2093. PROCEDURE TCluster.DrawBox (Const Icon: String; Marker: Char);
  2094. BEGIN
  2095. DrawMultiBox(Icon, ' '+Marker); { Call draw routine }
  2096. END;
  2097. {--TCluster-----------------------------------------------------------------}
  2098. { SetButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2099. {---------------------------------------------------------------------------}
  2100. PROCEDURE TCluster.SetButtonState (AMask: Longint; Enable: Boolean);
  2101. VAR I: Sw_Integer; M: Longint;
  2102. BEGIN
  2103. If Enable Then EnableMask := EnableMask OR AMask { Set enable bit mask }
  2104. Else EnableMask := EnableMask AND NOT AMask; { Disable bit mask }
  2105. If (Strings.Count <= 32) Then Begin { Valid string number }
  2106. M := 1; { Preset bit masks }
  2107. For I := 1 To Strings.Count Do Begin { For each item string }
  2108. If ((M AND EnableMask) <> 0) Then Begin { Bit enabled }
  2109. Options := Options OR ofSelectable; { Set selectable option }
  2110. Exit; { Now exit }
  2111. End;
  2112. M := M SHL 1; { Create newbit mask }
  2113. End;
  2114. Options := Options AND NOT ofSelectable; { Make not selectable }
  2115. End;
  2116. END;
  2117. {--TCluster-----------------------------------------------------------------}
  2118. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2119. {---------------------------------------------------------------------------}
  2120. PROCEDURE TCluster.GetData (Var Rec);
  2121. BEGIN
  2122. sw_Word(Rec) := Value; { Return current value }
  2123. END;
  2124. {--TCluster-----------------------------------------------------------------}
  2125. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2126. {---------------------------------------------------------------------------}
  2127. PROCEDURE TCluster.SetData (Var Rec);
  2128. BEGIN
  2129. Value :=sw_Word(Rec); { Set current value }
  2130. SetDrawMask(vdFocus OR vdInner); { Set redraw mask }
  2131. DrawView; { Redraw masked areas }
  2132. END;
  2133. {--TCluster-----------------------------------------------------------------}
  2134. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2135. {---------------------------------------------------------------------------}
  2136. PROCEDURE TCluster.Store (Var S: TStream);
  2137. var
  2138. w : word;
  2139. BEGIN
  2140. TView.Store(S); { TView.Store called }
  2141. If ((Options AND ofVersion) >= ofVersion20) { Version 2 TV view }
  2142. Then Begin
  2143. S.Write(Value, SizeOf(Value)); { Write value }
  2144. S.Write(Sel, SizeOf(Sel)); { Write select item }
  2145. S.Write(EnableMask, SizeOf(EnableMask)); { Write enable masks }
  2146. End Else Begin
  2147. w:=Value;
  2148. S.Write(w, SizeOf(Word)); { Write value }
  2149. S.Write(Sel, SizeOf(Sel)); { Write select item }
  2150. End;
  2151. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  2152. S.Write(Id, SizeOf(Id)); { Write new id value }
  2153. Strings.Store(S); { Store strings }
  2154. END;
  2155. {--TCluster-----------------------------------------------------------------}
  2156. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Jun98 LdB }
  2157. {---------------------------------------------------------------------------}
  2158. PROCEDURE TCluster.HandleEvent (Var Event: TEvent);
  2159. VAR C: Char; I, J, S, Vh: Sw_Integer; Key: Word; Mouse: TPoint; Ts: PString;
  2160. PROCEDURE MoveSel;
  2161. BEGIN
  2162. If (I <= Strings.Count) Then Begin
  2163. Sel := S; { Set selected item }
  2164. MovedTo(Sel); { Move to selected }
  2165. SetDrawMask(vdInner OR vdFocus); { Set draw masks }
  2166. DrawView; { Now draw changes }
  2167. End;
  2168. END;
  2169. BEGIN
  2170. Inherited HandleEvent(Event); { Call ancestor }
  2171. If ((Options AND ofSelectable) = 0) Then Exit; { Check selectable }
  2172. If (Event.What = evMouseDown) Then Begin { MOUSE EVENT }
  2173. MakeLocal(Event.Where, Mouse); { Make point local }
  2174. I := FindSel(Mouse); { Find selected item }
  2175. If (I <> -1) Then { Check in view }
  2176. If ButtonState(I) Then Sel := I; { If enabled select }
  2177. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  2178. DrawView; { Now draw changes }
  2179. Repeat
  2180. MakeLocal(Event.Where, Mouse); { Make point local }
  2181. Until NOT MouseEvent(Event, evMouseMove); { Wait for mouse up }
  2182. MakeLocal(Event.Where, Mouse); { Make point local }
  2183. If (FindSel(Mouse) = Sel) AND ButtonState(Sel) { If valid/selected }
  2184. Then Begin
  2185. Press(Sel); { Call pressed }
  2186. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  2187. DrawView; { Now draw changes }
  2188. End;
  2189. ClearEvent(Event); { Event was handled }
  2190. End Else If (Event.What = evKeyDown) Then Begin { KEY EVENT }
  2191. If (Options AND ofFramed <> 0) OR { Normal frame }
  2192. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2193. J := 1 Else J := 0; { Adjust value }
  2194. Vh := Size.Y - J - J; { View height }
  2195. S := Sel; { Hold current item }
  2196. Key := CtrlToArrow(Event.KeyCode); { Convert keystroke }
  2197. Case Key Of
  2198. kbUp, kbDown, kbRight, kbLeft:
  2199. If (State AND sfFocused <> 0) Then Begin { Focused key event }
  2200. I := 0; { Zero process count }
  2201. Repeat
  2202. Inc(I); { Inc process count }
  2203. Case Key Of
  2204. kbUp: Dec(S); { Next item up }
  2205. kbDown: Inc(S); { Next item down }
  2206. kbRight: Begin { Next column across }
  2207. Inc(S, Vh); { Move to next column }
  2208. If (S >= Strings.Count) Then { No next column check }
  2209. S := (S+1) MOD Vh; { Move to last column }
  2210. End;
  2211. kbLeft: Begin { Prior column across }
  2212. Dec(S, Vh); { Move to prior column }
  2213. If (S < 0) Then S := ((Strings.Count +
  2214. Vh - 1) DIV Vh) * Vh + S - 1; { No prior column check }
  2215. End;
  2216. End;
  2217. If (S >= Strings.Count) Then S := 0; { Roll up to top }
  2218. If (S < 0) Then S := Strings.Count - 1; { Roll down to bottom }
  2219. Until ButtonState(S) OR (I > Strings.Count); { Repeat until select }
  2220. MoveSel; { Move to selected }
  2221. ClearEvent(Event); { Event was handled }
  2222. End;
  2223. Else Begin { Not an arrow key }
  2224. For I := 0 To Strings.Count-1 Do Begin { Scan each item }
  2225. Ts := Strings.At(I); { Fetch string pointer }
  2226. If (Ts <> Nil) Then C := HotKey(Ts^) { Check for hotkey }
  2227. Else C := #0; { No valid string }
  2228. If (GetAltCode(C) = Event.KeyCode) OR { Hot key for item }
  2229. (((Owner^.Phase = phPostProcess) OR { Owner in post process }
  2230. (State AND sfFocused <> 0)) AND (C <> #0) { Non zero hotkey }
  2231. AND (UpCase(Event.CharCode) = C)) { Matches current key }
  2232. Then Begin
  2233. If ButtonState(I) Then Begin { Check mask enabled }
  2234. If Focus Then Begin { Check view focus }
  2235. Sel := I; { Set selected }
  2236. MovedTo(Sel); { Move to selected }
  2237. Press(Sel); { Call pressed }
  2238. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  2239. DrawView; { Now draw changes }
  2240. End;
  2241. ClearEvent(Event); { Event was handled }
  2242. End;
  2243. Exit; { Now exit }
  2244. End;
  2245. End;
  2246. If (Event.CharCode = ' ') AND { Spacebar key }
  2247. (State AND sfFocused <> 0) AND { Check focused view }
  2248. ButtonState(Sel) Then Begin { Check item enabled }
  2249. Press(Sel); { Call pressed }
  2250. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  2251. DrawView; { Now draw changes }
  2252. ClearEvent(Event); { Event was handled }
  2253. End;
  2254. End;
  2255. End;
  2256. End;
  2257. END;
  2258. {***************************************************************************}
  2259. { TCluster OBJECT PRIVATE METHODS }
  2260. {***************************************************************************}
  2261. {--TCluster-----------------------------------------------------------------}
  2262. { FindSel -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2263. {---------------------------------------------------------------------------}
  2264. FUNCTION TCluster.FindSel (P: TPoint): Sw_Integer;
  2265. VAR I, J, S, Vh: Sw_Integer; R: TRect;
  2266. BEGIN
  2267. GetExtent(R); { Get view extents }
  2268. If R.Contains(P) Then Begin { Point in view }
  2269. If (Options AND ofFramed <> 0) OR { Normal frame }
  2270. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2271. J := 1 Else J := 0; { Adjust value }
  2272. Vh := Size.Y - J - J; { View height }
  2273. I := 0; { Preset zero value }
  2274. While (P.X >= Column(I+Vh)) Do Inc(I, Vh); { Inc view size }
  2275. S := I + P.Y - J; { Line to select }
  2276. If ((S >= 0) AND (S < Strings.Count)) { Valid selection }
  2277. Then FindSel := S Else FindSel := -1; { Return selected item }
  2278. End Else FindSel := -1; { Point outside view }
  2279. END;
  2280. {--TCluster-----------------------------------------------------------------}
  2281. { Row -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2282. {---------------------------------------------------------------------------}
  2283. FUNCTION TCluster.Row (Item: Sw_Integer): Sw_Integer;
  2284. BEGIN
  2285. If (Options AND ofFramed <> 0) OR { Normal frame }
  2286. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2287. Row := Item MOD (Size.Y - 2) Else { Allow for frames }
  2288. Row := Item MOD Size.Y; { Normal mod value }
  2289. END;
  2290. {--TCluster-----------------------------------------------------------------}
  2291. { Column -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2292. {---------------------------------------------------------------------------}
  2293. FUNCTION TCluster.Column (Item: Sw_Integer): Sw_Integer;
  2294. VAR I, J, Col, Width, L, Vh: Sw_Integer; Ts: PString;
  2295. BEGIN
  2296. If (Options AND ofFramed <> 0) OR { Normal frame }
  2297. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2298. J := 1 Else J := 0; { Adjust value }
  2299. Vh := Size.Y - J - J; { Vertical size }
  2300. If (Item >= Vh) Then Begin { Valid selection }
  2301. Width := 0; { Zero width }
  2302. Col := -6; { Start column at -6 }
  2303. For I := 0 To Item Do Begin { For each item }
  2304. If (I MOD Vh = 0) Then Begin { Start next column }
  2305. Inc(Col, Width + 6); { Add column width }
  2306. Width := 0; { Zero width }
  2307. End;
  2308. If (I < Strings.Count) Then Begin { Valid string }
  2309. Ts := Strings.At(I); { Transfer string }
  2310. If (Ts <> Nil) Then L := CStrLen(Ts^) { Length of string }
  2311. Else L := 0; { No string }
  2312. End;
  2313. If (L > Width) Then Width := L; { Hold longest string }
  2314. End;
  2315. Column := Col; { Return column }
  2316. End Else Column := 0; { Outside select area }
  2317. END;
  2318. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2319. { TRadioButtons OBJECT METHODS }
  2320. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2321. {--TRadioButtons------------------------------------------------------------}
  2322. { Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2323. {---------------------------------------------------------------------------}
  2324. FUNCTION TRadioButtons.Mark (Item: Sw_Integer): Boolean;
  2325. BEGIN
  2326. Mark := Item = Value; { True if item = value }
  2327. END;
  2328. {--TRadioButtons------------------------------------------------------------}
  2329. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2330. {---------------------------------------------------------------------------}
  2331. PROCEDURE TRadioButtons.DrawFocus;
  2332. CONST Button = ' ( ) ';
  2333. BEGIN
  2334. Inherited DrawFocus;
  2335. DrawMultiBox(Button, ' *'); { Redraw the text }
  2336. END;
  2337. {--TRadioButtons------------------------------------------------------------}
  2338. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2339. {---------------------------------------------------------------------------}
  2340. PROCEDURE TRadioButtons.Press (Item: Sw_Integer);
  2341. BEGIN
  2342. Value := Item; { Set value field }
  2343. Inherited Press(Item); { Call ancestor }
  2344. END;
  2345. {--TRadioButtons------------------------------------------------------------}
  2346. { MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2347. {---------------------------------------------------------------------------}
  2348. PROCEDURE TRadioButtons.MovedTo (Item: Sw_Integer);
  2349. BEGIN
  2350. Value := Item; { Set value to item }
  2351. If (Id <> 0) Then NewMessage(Owner, evCommand,
  2352. cmIdCommunicate, Id, Value, @Self); { Send new message }
  2353. END;
  2354. {--TRadioButtons------------------------------------------------------------}
  2355. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2356. {---------------------------------------------------------------------------}
  2357. PROCEDURE TRadioButtons.SetData (Var Rec);
  2358. BEGIN
  2359. Sel := Sw_word(Rec); { Set selection }
  2360. Inherited SetData(Rec); { Call ancestor }
  2361. END;
  2362. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2363. { TCheckBoxes OBJECT METHODS }
  2364. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2365. {--TCheckBoxes--------------------------------------------------------------}
  2366. { Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2367. {---------------------------------------------------------------------------}
  2368. FUNCTION TCheckBoxes.Mark(Item: Sw_Integer): Boolean;
  2369. BEGIN
  2370. If (Value AND (1 SHL Item) <> 0) Then { Check if item ticked }
  2371. Mark := True Else Mark := False; { Return result }
  2372. END;
  2373. {--TCheckBoxes--------------------------------------------------------------}
  2374. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2375. {---------------------------------------------------------------------------}
  2376. PROCEDURE TCheckBoxes.DrawFocus;
  2377. CONST Button = ' [ ] ';
  2378. BEGIN
  2379. Inherited DrawFocus;
  2380. DrawMultiBox(Button, ' X'); { Redraw the text }
  2381. END;
  2382. {--TCheckBoxes--------------------------------------------------------------}
  2383. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2384. {---------------------------------------------------------------------------}
  2385. PROCEDURE TCheckBoxes.Press (Item: Sw_Integer);
  2386. BEGIN
  2387. Value := Value XOR (1 SHL Item); { Flip the item mask }
  2388. Inherited Press(Item); { Call ancestor }
  2389. END;
  2390. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2391. { TMultiCheckBoxes OBJECT METHODS }
  2392. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2393. {--TMultiCheckBoxes---------------------------------------------------------}
  2394. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Jun98 LdB }
  2395. {---------------------------------------------------------------------------}
  2396. CONSTRUCTOR TMultiCheckBoxes.Init (Var Bounds: TRect; AStrings: PSItem;
  2397. ASelRange: Byte; AFlags: Word; Const AStates: String);
  2398. BEGIN
  2399. Inherited Init(Bounds, AStrings); { Call ancestor }
  2400. SelRange := ASelRange; { Hold select range }
  2401. Flags := AFlags; { Hold flags }
  2402. States := NewStr(AStates); { Hold string }
  2403. END;
  2404. {--TMultiCheckBoxes---------------------------------------------------------}
  2405. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2406. {---------------------------------------------------------------------------}
  2407. CONSTRUCTOR TMultiCheckBoxes.Load (Var S: TStream);
  2408. BEGIN
  2409. Inherited Load(S); { Call ancestor }
  2410. S.Read(SelRange, SizeOf(SelRange)); { Read select range }
  2411. S.Read(Flags, SizeOf(Flags)); { Read flags }
  2412. States := S.ReadStr; { Read strings }
  2413. END;
  2414. {--TMultiCheckBoxes---------------------------------------------------------}
  2415. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2416. {---------------------------------------------------------------------------}
  2417. DESTRUCTOR TMultiCheckBoxes.Done;
  2418. BEGIN
  2419. If (States <> Nil) Then DisposeStr(States); { Dispose strings }
  2420. Inherited Done; { Call ancestor }
  2421. END;
  2422. {--TMultiCheckBoxes---------------------------------------------------------}
  2423. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2424. {---------------------------------------------------------------------------}
  2425. FUNCTION TMultiCheckBoxes.DataSize: Sw_Word;
  2426. BEGIN
  2427. DataSize := SizeOf(LongInt); { Size to exchange }
  2428. END;
  2429. {--TMultiCheckBoxes---------------------------------------------------------}
  2430. { MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2431. {---------------------------------------------------------------------------}
  2432. FUNCTION TMultiCheckBoxes.MultiMark (Item: Sw_Integer): Byte;
  2433. BEGIN
  2434. MultiMark := (Value SHR (Word(Item) *
  2435. WordRec(Flags).Hi)) AND WordRec(Flags).Lo; { Return mark state }
  2436. END;
  2437. {--TMultiCheckBoxes---------------------------------------------------------}
  2438. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2439. {---------------------------------------------------------------------------}
  2440. PROCEDURE TMultiCheckBoxes.DrawFocus;
  2441. CONST Button = ' [ ] ';
  2442. BEGIN
  2443. Inherited DrawFocus;
  2444. DrawMultiBox(Button, States^); { Draw the items }
  2445. END;
  2446. {--TMultiCheckBoxes---------------------------------------------------------}
  2447. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2448. {---------------------------------------------------------------------------}
  2449. PROCEDURE TMultiCheckBoxes.Press (Item: Sw_Integer);
  2450. VAR CurState: ShortInt;
  2451. BEGIN
  2452. CurState := (Value SHR (Word(Item) *
  2453. WordRec(Flags).Hi)) AND WordRec(Flags).Lo; { Hold current state }
  2454. Dec(CurState); { One down }
  2455. If (CurState >= SelRange) OR (CurState < 0) Then
  2456. CurState := SelRange - 1; { Roll if needed }
  2457. Value := (Value AND NOT (LongInt(WordRec(Flags).Lo)
  2458. SHL (Word(Item) * WordRec(Flags).Hi))) OR
  2459. (LongInt(CurState) SHL (Word(Item) *
  2460. WordRec(Flags).Hi)); { Calculate value }
  2461. Inherited Press(Item); { Call ancestor }
  2462. END;
  2463. {--TMultiCheckBoxes---------------------------------------------------------}
  2464. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2465. {---------------------------------------------------------------------------}
  2466. PROCEDURE TMultiCheckBoxes.GetData (Var Rec);
  2467. BEGIN
  2468. Longint(Rec) := Value; { Return value }
  2469. END;
  2470. {--TMultiCheckBoxes---------------------------------------------------------}
  2471. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2472. {---------------------------------------------------------------------------}
  2473. PROCEDURE TMultiCheckBoxes.SetData (Var Rec);
  2474. BEGIN
  2475. Value := Longint(Rec); { Set value }
  2476. SetDrawMask(vdFocus OR vdInner); { Set redraw mask }
  2477. DrawView; { Redraw masked areas }
  2478. END;
  2479. {--TMultiCheckBoxes---------------------------------------------------------}
  2480. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2481. {---------------------------------------------------------------------------}
  2482. PROCEDURE TMultiCheckBoxes.Store (Var S: TStream);
  2483. BEGIN
  2484. TCluster.Store(S); { TCluster store called }
  2485. S.Write(SelRange, SizeOf(SelRange)); { Write select range }
  2486. S.Write(Flags, SizeOf(Flags)); { Write select flags }
  2487. S.WriteStr(States); { Write strings }
  2488. END;
  2489. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2490. { TListBox OBJECT METHODS }
  2491. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2492. TYPE
  2493. TListBoxRec = PACKED RECORD
  2494. List: PCollection; { List collection ptr }
  2495. Selection: Word; { Selected item }
  2496. END;
  2497. {--TListBox-----------------------------------------------------------------}
  2498. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2499. {---------------------------------------------------------------------------}
  2500. CONSTRUCTOR TListBox.Init (Var Bounds: TRect; ANumCols: Sw_Word;
  2501. AScrollBar: PScrollBar);
  2502. BEGIN
  2503. Inherited Init(Bounds, ANumCols, Nil, AScrollBar); { Call ancestor }
  2504. SetRange(0); { Set range to zero }
  2505. END;
  2506. {--TListBox-----------------------------------------------------------------}
  2507. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2508. {---------------------------------------------------------------------------}
  2509. CONSTRUCTOR TListBox.Load (Var S: TStream);
  2510. BEGIN
  2511. Inherited Load(S); { Call ancestor }
  2512. List := PCollection(S.Get); { Fetch collection }
  2513. END;
  2514. {--TListBox-----------------------------------------------------------------}
  2515. { DataSize -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 06Jun98 LdB }
  2516. {---------------------------------------------------------------------------}
  2517. FUNCTION TListBox.DataSize: Sw_Word;
  2518. BEGIN
  2519. DataSize := SizeOf(TListBoxRec); { Xchg data size }
  2520. END;
  2521. {--TListBox-----------------------------------------------------------------}
  2522. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2523. {---------------------------------------------------------------------------}
  2524. FUNCTION TListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2525. VAR P: PString;
  2526. BEGIN
  2527. GetText := ''; { Preset return }
  2528. If (List <> Nil) Then Begin { A list exists }
  2529. P := PString(List^.At(Item)); { Get string ptr }
  2530. If (P <> Nil) Then GetText := P^; { Return string }
  2531. End;
  2532. END;
  2533. {--TListBox-----------------------------------------------------------------}
  2534. { NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2535. {---------------------------------------------------------------------------}
  2536. PROCEDURE TListBox.NewList (AList: PCollection);
  2537. BEGIN
  2538. If (List <> Nil) Then Dispose(List, Done); { Dispose old list }
  2539. List := AList; { Hold new list }
  2540. If (AList <> Nil) Then SetRange(AList^.Count) { Set new item range }
  2541. Else SetRange(0); { Set zero range }
  2542. If (Range > 0) Then FocusItem(0); { Focus first item }
  2543. DrawView; { Redraw all view }
  2544. END;
  2545. {--TListBox-----------------------------------------------------------------}
  2546. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2547. {---------------------------------------------------------------------------}
  2548. PROCEDURE TListBox.GetData (Var Rec);
  2549. BEGIN
  2550. TListBoxRec(Rec).List := List; { Return current list }
  2551. TListBoxRec(Rec).Selection := Focused; { Return focused item }
  2552. END;
  2553. {--TListBox-----------------------------------------------------------------}
  2554. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2555. {---------------------------------------------------------------------------}
  2556. PROCEDURE TListBox.SetData (Var Rec);
  2557. BEGIN
  2558. NewList(TListBoxRec(Rec).List); { Hold new list }
  2559. FocusItem(TListBoxRec(Rec).Selection); { Focus selected item }
  2560. DrawView; { Redraw all view }
  2561. END;
  2562. {--TListBox-----------------------------------------------------------------}
  2563. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2564. {---------------------------------------------------------------------------}
  2565. PROCEDURE TListBox.Store (Var S: TStream);
  2566. BEGIN
  2567. TListViewer.Store(S); { TListViewer store }
  2568. S.Put(List); { Store list to stream }
  2569. END;
  2570. {****************************************************************************}
  2571. { TListBox.DeleteFocusedItem }
  2572. {****************************************************************************}
  2573. procedure TListBox.DeleteFocusedItem;
  2574. begin
  2575. DeleteItem(Focused);
  2576. end;
  2577. {****************************************************************************}
  2578. { TListBox.DeleteItem }
  2579. {****************************************************************************}
  2580. procedure TListBox.DeleteItem (Item : Sw_Integer);
  2581. begin
  2582. if (List <> nil) and (List^.Count > 0) and
  2583. ((Item < List^.Count) and (Item > -1)) then begin
  2584. if IsSelected(Item) and (Item > 0) then
  2585. FocusItem(Item - 1);
  2586. List^.AtDelete(Item);
  2587. SetRange(List^.Count);
  2588. end;
  2589. end;
  2590. {****************************************************************************}
  2591. { TListBox.FreeAll }
  2592. {****************************************************************************}
  2593. procedure TListBox.FreeAll;
  2594. begin
  2595. if (List <> nil) then
  2596. begin
  2597. List^.FreeAll;
  2598. SetRange(List^.Count);
  2599. end;
  2600. end;
  2601. {****************************************************************************}
  2602. { TListBox.FreeFocusedItem }
  2603. {****************************************************************************}
  2604. procedure TListBox.FreeFocusedItem;
  2605. begin
  2606. FreeItem(Focused);
  2607. end;
  2608. {****************************************************************************}
  2609. { TListBox.FreeItem }
  2610. {****************************************************************************}
  2611. procedure TListBox.FreeItem (Item : Sw_Integer);
  2612. begin
  2613. if (Item > -1) and (Item < Range) then
  2614. begin
  2615. List^.AtFree(Item);
  2616. if (Range > 1) and (Focused >= List^.Count) then
  2617. Dec(Focused);
  2618. SetRange(List^.Count);
  2619. end;
  2620. end;
  2621. {****************************************************************************}
  2622. { TListBox.SetFocusedItem }
  2623. {****************************************************************************}
  2624. procedure TListBox.SetFocusedItem (Item : Pointer);
  2625. begin
  2626. FocusItem(List^.IndexOf(Item));
  2627. end;
  2628. {****************************************************************************}
  2629. { TListBox.GetFocusedItem }
  2630. {****************************************************************************}
  2631. function TListBox.GetFocusedItem : Pointer;
  2632. begin
  2633. if (List = nil) or (List^.Count = 0) then
  2634. GetFocusedItem := nil
  2635. else GetFocusedItem := List^.At(Focused);
  2636. end;
  2637. {****************************************************************************}
  2638. { TListBox.Insert }
  2639. {****************************************************************************}
  2640. procedure TListBox.Insert (Item : Pointer);
  2641. begin
  2642. if (List <> nil) then
  2643. begin
  2644. List^.Insert(Item);
  2645. SetRange(List^.Count);
  2646. end;
  2647. end;
  2648. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2649. { TStaticText OBJECT METHODS }
  2650. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2651. {--TStaticText--------------------------------------------------------------}
  2652. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2653. {---------------------------------------------------------------------------}
  2654. CONSTRUCTOR TStaticText.Init (Var Bounds: TRect; Const AText: String);
  2655. BEGIN
  2656. Inherited Init(Bounds); { Call ancestor }
  2657. Text := NewStr(AText); { Create string ptr }
  2658. END;
  2659. {--TStaticText--------------------------------------------------------------}
  2660. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2661. {---------------------------------------------------------------------------}
  2662. CONSTRUCTOR TStaticText.Load (Var S: TStream);
  2663. BEGIN
  2664. Inherited Load(S); { Call ancestor }
  2665. Text := S.ReadStr; { Read text string }
  2666. END;
  2667. {--TStaticText--------------------------------------------------------------}
  2668. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2669. {---------------------------------------------------------------------------}
  2670. DESTRUCTOR TStaticText.Done;
  2671. BEGIN
  2672. If (Text <> Nil) Then DisposeStr(Text); { Dispose string }
  2673. Inherited Done; { Call ancestor }
  2674. END;
  2675. {--TStaticText--------------------------------------------------------------}
  2676. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2677. {---------------------------------------------------------------------------}
  2678. FUNCTION TStaticText.GetPalette: PPalette;
  2679. CONST P: String[Length(CStaticText)] = CStaticText; { Always normal string }
  2680. BEGIN
  2681. GetPalette := @P; { Return palette }
  2682. END;
  2683. {--TStaticText--------------------------------------------------------------}
  2684. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2685. {---------------------------------------------------------------------------}
  2686. PROCEDURE TStaticText.DrawBackGround;
  2687. VAR Just: Byte; I, J, P, Y, L: Sw_Integer; S, T: String;
  2688. BEGIN
  2689. Inherited DrawBackGround; { Call ancestor }
  2690. GetText(S); { Fetch text to write }
  2691. P := 1; { X start position }
  2692. Y := 0; { Y start position }
  2693. L := Length(S); { Length of text }
  2694. While (Y < Size.Y) AND (P <= L) Do Begin
  2695. Just := 0; { Default left justify }
  2696. If (S[P] = #2) Then Begin { Right justify char }
  2697. Just := 2; { Set right justify }
  2698. Inc(P); { Next character }
  2699. End;
  2700. If (S[P] = #3) Then Begin { Centre justify char }
  2701. Just := 1; { Set centre justify }
  2702. Inc(P); { Next character }
  2703. End;
  2704. I := P; { Start position }
  2705. While (P <= L) AND (P-I <= Size.X) AND (S[P] <> #13) Do
  2706. Inc(P); { Scan for end }
  2707. T := Copy(S, I, P-I); { String to write }
  2708. Case Just Of
  2709. 0: J := 0; { Left justify }
  2710. 1: J := (RawSize.X - TextWidth(T)) DIV 2; { Centre justify }
  2711. 2: J := RawSize.X - TextWidth(T); { Right justify }
  2712. End;
  2713. While (J < 0) Do Begin { Text to long }
  2714. J := J + TextWidth(T[1]); { Add width to J }
  2715. Delete(T, 1, 1); { Delete the char }
  2716. End;
  2717. WriteStr(-J, -(Y*FontHeight), T, 1); { Write the text }
  2718. While (P <= L) AND (P-I <= Size.X) AND ((S[P] = #13) OR (S[P] = #10))
  2719. Do Inc(P); { Remove CR/LF }
  2720. Inc(Y); { Next line }
  2721. End;
  2722. END;
  2723. {--TStaticText--------------------------------------------------------------}
  2724. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2725. {---------------------------------------------------------------------------}
  2726. PROCEDURE TStaticText.Store (Var S: TStream);
  2727. BEGIN
  2728. TView.Store(S); { Call TView store }
  2729. S.WriteStr(Text); { Write text string }
  2730. END;
  2731. {--TStaticText--------------------------------------------------------------}
  2732. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2733. {---------------------------------------------------------------------------}
  2734. PROCEDURE TStaticText.GetText (Var S: String);
  2735. BEGIN
  2736. If (Text <> Nil) Then S := Text^ { Copy text string }
  2737. Else S := ''; { Return empty string }
  2738. END;
  2739. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2740. { TParamText OBJECT METHODS }
  2741. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2742. {--TParamText---------------------------------------------------------------}
  2743. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2744. {---------------------------------------------------------------------------}
  2745. CONSTRUCTOR TParamText.Init (Var Bounds: TRect; Const AText: String;
  2746. AParamCount: Sw_Integer);
  2747. BEGIN
  2748. Inherited Init(Bounds, AText); { Call ancestor }
  2749. ParamCount := AParamCount; { Hold param count }
  2750. END;
  2751. {--TParamText---------------------------------------------------------------}
  2752. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2753. {---------------------------------------------------------------------------}
  2754. CONSTRUCTOR TParamText.Load (Var S: TStream);
  2755. VAR w: Word;
  2756. BEGIN
  2757. Inherited Load(S); { Call ancestor }
  2758. S.Read(w, SizeOf(w)); ParamCount:=w; { Read parameter count }
  2759. END;
  2760. {--TParamText---------------------------------------------------------------}
  2761. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2762. {---------------------------------------------------------------------------}
  2763. FUNCTION TParamText.DataSize: Sw_Word;
  2764. BEGIN
  2765. DataSize := ParamCount * SizeOf(Pointer); { Return data size }
  2766. END;
  2767. {--TParamText---------------------------------------------------------------}
  2768. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2769. {---------------------------------------------------------------------------}
  2770. PROCEDURE TParamText.GetData (Var Rec);
  2771. BEGIN
  2772. Pointer(Rec) := @ParamList; { Return parm ptr }
  2773. END;
  2774. {--TParamText---------------------------------------------------------------}
  2775. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2776. {---------------------------------------------------------------------------}
  2777. PROCEDURE TParamText.SetData (Var Rec);
  2778. BEGIN
  2779. ParamList := @Rec; { Fetch parameter list }
  2780. DrawView; { Redraw all the view }
  2781. END;
  2782. {--TParamText---------------------------------------------------------------}
  2783. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2784. {---------------------------------------------------------------------------}
  2785. PROCEDURE TParamText.Store (Var S: TStream);
  2786. VAR w: Word;
  2787. BEGIN
  2788. TStaticText.Store(S); { Statictext store }
  2789. w:=ParamCount;S.Write(w, SizeOf(w)); { Store param count }
  2790. END;
  2791. {--TParamText---------------------------------------------------------------}
  2792. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2793. {---------------------------------------------------------------------------}
  2794. PROCEDURE TParamText.GetText (Var S: String);
  2795. BEGIN
  2796. If (Text = Nil) Then S := '' Else { Return empty string }
  2797. FormatStr(S, Text^, ParamList^); { Return text string }
  2798. END;
  2799. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2800. { TLabel OBJECT METHODS }
  2801. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2802. {--TLabel-------------------------------------------------------------------}
  2803. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2804. {---------------------------------------------------------------------------}
  2805. CONSTRUCTOR TLabel.Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
  2806. BEGIN
  2807. Inherited Init(Bounds, AText); { Call ancestor }
  2808. Link := ALink; { Hold link }
  2809. Options := Options OR (ofPreProcess+ofPostProcess);{ Set pre/post process }
  2810. EventMask := EventMask OR evBroadcast; { Sees broadcast events }
  2811. END;
  2812. {--TLabel-------------------------------------------------------------------}
  2813. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2814. {---------------------------------------------------------------------------}
  2815. CONSTRUCTOR TLabel.Load (Var S: TStream);
  2816. BEGIN
  2817. Inherited Load(S); { Call ancestor }
  2818. GetPeerViewPtr(S, Link); { Load link view }
  2819. END;
  2820. {--TLabel-------------------------------------------------------------------}
  2821. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2822. {---------------------------------------------------------------------------}
  2823. FUNCTION TLabel.GetPalette: PPalette;
  2824. CONST P: String[Length(CLabel)] = CLabel; { Always normal string }
  2825. BEGIN
  2826. GetPalette := @P; { Return palette }
  2827. END;
  2828. {--TLabel-------------------------------------------------------------------}
  2829. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2830. {---------------------------------------------------------------------------}
  2831. PROCEDURE TLabel.DrawBackGround;
  2832. VAR SCOff: Byte; Color: Word; B: TDrawBuffer;
  2833. BEGIN
  2834. TView.DrawBackGround; { Explict call to TView }
  2835. If Light Then Begin { Light colour select }
  2836. Color := GetColor($0402); { Choose light colour }
  2837. SCOff := 0; { Zero offset }
  2838. End Else Begin
  2839. Color := GetColor($0301); { Darker colour }
  2840. SCOff := 4; { Set offset }
  2841. End;
  2842. MoveChar(B[0], ' ', Byte(Color), Size.X); { Clear the buffer }
  2843. If (Text <> Nil) Then MoveCStr(B[1], Text^, Color);{ Transfer label text }
  2844. If ShowMarkers Then WordRec(B[0]).Lo := Byte(
  2845. SpecialChars[SCOff]); { Show marker if req }
  2846. WriteLine(0, 0, Size.X, 1, B); { Write the text }
  2847. END;
  2848. {--TLabel-------------------------------------------------------------------}
  2849. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2850. {---------------------------------------------------------------------------}
  2851. PROCEDURE TLabel.Store (Var S: TStream);
  2852. BEGIN
  2853. TStaticText.Store(S); { TStaticText.Store }
  2854. PutPeerViewPtr(S, Link); { Store link view }
  2855. END;
  2856. {--TLabel-------------------------------------------------------------------}
  2857. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2858. {---------------------------------------------------------------------------}
  2859. PROCEDURE TLabel.HandleEvent (Var Event: TEvent);
  2860. VAR C: Char;
  2861. PROCEDURE FocusLink;
  2862. BEGIN
  2863. If (Link <> Nil) AND (Link^.Options AND
  2864. ofSelectable <> 0) Then Link^.Focus; { Focus link view }
  2865. ClearEvent(Event); { Clear the event }
  2866. END;
  2867. BEGIN
  2868. Inherited HandleEvent(Event); { Call ancestor }
  2869. Case Event.What Of
  2870. evNothing: Exit; { Speed up exit }
  2871. evMouseDown: FocusLink; { Focus link view }
  2872. evKeyDown: Begin
  2873. C := HotKey(Text^); { Check for hotkey }
  2874. If (GetAltCode(C) = Event.KeyCode) OR { Alt plus char }
  2875. ((C <> #0) AND (Owner^.Phase = phPostProcess) { Post process phase }
  2876. AND (UpCase(Event.CharCode) = C)) Then { Upper case match }
  2877. FocusLink; { Focus link view }
  2878. End;
  2879. evBroadcast: If ((Event.Command = cmReceivedFocus)
  2880. OR (Event.Command = cmReleasedFocus)) AND { Focus state change }
  2881. (Link <> Nil) Then Begin
  2882. Light := Link^.State AND sfFocused <> 0; { Change light state }
  2883. DrawView; { Now redraw change }
  2884. End;
  2885. End;
  2886. END;
  2887. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2888. { THistoryViewer OBJECT METHODS }
  2889. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2890. {--THistoryViewer-----------------------------------------------------------}
  2891. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2892. {---------------------------------------------------------------------------}
  2893. CONSTRUCTOR THistoryViewer.Init (Var Bounds: TRect; AHScrollBar,
  2894. AVScrollBar: PScrollBar; AHistoryId: Word);
  2895. BEGIN
  2896. Inherited Init(Bounds, 1, AHScrollBar,
  2897. AVScrollBar); { Call ancestor }
  2898. HistoryId := AHistoryId; { Hold history id }
  2899. SetRange(HistoryCount(AHistoryId)); { Set history range }
  2900. If (Range > 1) Then FocusItem(1); { Set to item 1 }
  2901. If (HScrollBar <> Nil) Then
  2902. HScrollBar^.SetRange(1, HistoryWidth-Size.X + 3);{ Set scrollbar range }
  2903. END;
  2904. {--THistoryViewer-----------------------------------------------------------}
  2905. { HistoryWidth -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2906. {---------------------------------------------------------------------------}
  2907. FUNCTION THistoryViewer.HistoryWidth: Sw_Integer;
  2908. VAR Width, T, Count, I: Sw_Integer;
  2909. BEGIN
  2910. Width := 0; { Zero width variable }
  2911. Count := HistoryCount(HistoryId); { Hold count value }
  2912. For I := 0 To Count-1 Do Begin { For each item }
  2913. T := Length(HistoryStr(HistoryId, I)); { Get width of item }
  2914. If (T > Width) Then Width := T; { Set width to max }
  2915. End;
  2916. HistoryWidth := Width; { Return max item width }
  2917. END;
  2918. {--THistoryViewer-----------------------------------------------------------}
  2919. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2920. {---------------------------------------------------------------------------}
  2921. FUNCTION THistoryViewer.GetPalette: PPalette;
  2922. CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
  2923. BEGIN
  2924. GetPalette := @P; { Return palette }
  2925. END;
  2926. {--THistoryViewer-----------------------------------------------------------}
  2927. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2928. {---------------------------------------------------------------------------}
  2929. FUNCTION THistoryViewer.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
  2930. BEGIN
  2931. GetText := HistoryStr(HistoryId, Item); { Return history string }
  2932. END;
  2933. {--THistoryViewer-----------------------------------------------------------}
  2934. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2935. {---------------------------------------------------------------------------}
  2936. PROCEDURE THistoryViewer.HandleEvent (Var Event: TEvent);
  2937. BEGIN
  2938. If ((Event.What = evMouseDown) AND (Event.Double)) { Double click mouse }
  2939. OR ((Event.What = evKeyDown) AND
  2940. (Event.KeyCode = kbEnter)) Then Begin { Enter key press }
  2941. EndModal(cmOk); { End with cmOk }
  2942. ClearEvent(Event); { Event was handled }
  2943. End Else If ((Event.What = evKeyDown) AND
  2944. (Event.KeyCode = kbEsc)) OR { Esc key press }
  2945. ((Event.What = evCommand) AND
  2946. (Event.Command = cmCancel)) Then Begin { Cancel command }
  2947. EndModal(cmCancel); { End with cmCancel }
  2948. ClearEvent(Event); { Event was handled }
  2949. End Else Inherited HandleEvent(Event); { Call ancestor }
  2950. END;
  2951. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2952. { THistoryWindow OBJECT METHODS }
  2953. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2954. {--THistoryWindow-----------------------------------------------------------}
  2955. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2956. {---------------------------------------------------------------------------}
  2957. CONSTRUCTOR THistoryWindow.Init (Var Bounds: TRect; HistoryId: Word);
  2958. BEGIN
  2959. Inherited Init(Bounds, '', wnNoNumber); { Call ancestor }
  2960. Flags := wfClose; { Close flag only }
  2961. InitViewer(HistoryId); { Create list view }
  2962. END;
  2963. {--THistoryWindow-----------------------------------------------------------}
  2964. { GetSelection -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2965. {---------------------------------------------------------------------------}
  2966. FUNCTION THistoryWindow.GetSelection: String;
  2967. BEGIN
  2968. If (Viewer = Nil) Then GetSelection := '' Else { Return empty string }
  2969. GetSelection := Viewer^.GetText(Viewer^.Focused,
  2970. 255); { Get focused string }
  2971. END;
  2972. {--THistoryWindow-----------------------------------------------------------}
  2973. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2974. {---------------------------------------------------------------------------}
  2975. FUNCTION THistoryWindow.GetPalette: PPalette;
  2976. CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
  2977. BEGIN
  2978. GetPalette := @P; { Return the palette }
  2979. END;
  2980. {--THistoryWindow-----------------------------------------------------------}
  2981. { InitViewer -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2982. {---------------------------------------------------------------------------}
  2983. PROCEDURE THistoryWindow.InitViewer(HistoryId: Word);
  2984. VAR R: TRect;
  2985. BEGIN
  2986. GetExtent(R); { Get extents }
  2987. R.Grow(-1,-1); { Grow inside }
  2988. Viewer := New(PHistoryViewer, Init(R,
  2989. StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  2990. StandardScrollBar(sbVertical + sbHandleKeyboard),
  2991. HistoryId)); { Create the viewer }
  2992. If (Viewer <> Nil) Then Insert(Viewer); { Insert viewer }
  2993. END;
  2994. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2995. { THistory OBJECT METHODS }
  2996. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2997. {--THistory-----------------------------------------------------------------}
  2998. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2999. {---------------------------------------------------------------------------}
  3000. CONSTRUCTOR THistory.Init (Var Bounds: TRect; ALink: PInputLine;
  3001. AHistoryId: Word);
  3002. BEGIN
  3003. Inherited Init(Bounds); { Call ancestor }
  3004. Options := Options OR ofPostProcess; { Set post process }
  3005. EventMask := EventMask OR evBroadcast; { See broadcast events }
  3006. Link := ALink; { Hold link view }
  3007. HistoryId := AHistoryId; { Hold history id }
  3008. END;
  3009. {--THistory-----------------------------------------------------------------}
  3010. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  3011. {---------------------------------------------------------------------------}
  3012. CONSTRUCTOR THistory.Load (Var S: TStream);
  3013. BEGIN
  3014. Inherited Load(S); { Call ancestor }
  3015. GetPeerViewPtr(S, Link); { Load link view }
  3016. S.Read(HistoryId, SizeOf(HistoryId)); { Read history id }
  3017. END;
  3018. {--THistory-----------------------------------------------------------------}
  3019. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  3020. {---------------------------------------------------------------------------}
  3021. FUNCTION THistory.GetPalette: PPalette;
  3022. CONST P: String[Length(CHistory)] = CHistory; { Always normal string }
  3023. BEGIN
  3024. GetPalette := @P; { Return the palette }
  3025. END;
  3026. {--THistory-----------------------------------------------------------------}
  3027. { InitHistoryWindow -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  3028. {---------------------------------------------------------------------------}
  3029. FUNCTION THistory.InitHistoryWindow (Var Bounds: TRect): PHistoryWindow;
  3030. VAR P: PHistoryWindow;
  3031. BEGIN
  3032. P := New(PHistoryWindow, Init(Bounds, HistoryId)); { Create history window }
  3033. If (Link <> Nil) Then
  3034. P^.HelpCtx := Link^.HelpCtx; { Set help context }
  3035. InitHistoryWindow := P; { Return history window }
  3036. END;
  3037. PROCEDURE THistory.Draw;
  3038. VAR B: TDrawBuffer;
  3039. BEGIN
  3040. MoveCStr(B, #222'~'#25'~'#221, GetColor($0102)); { Set buffer data }
  3041. WriteLine(0, 0, Size.X, Size.Y, B); { Write buffer }
  3042. END;
  3043. {--THistory-----------------------------------------------------------------}
  3044. { RecordHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  3045. {---------------------------------------------------------------------------}
  3046. PROCEDURE THistory.RecordHistory (CONST S: String);
  3047. BEGIN
  3048. HistoryAdd(HistoryId, S); { Add to history }
  3049. END;
  3050. {--THistory-----------------------------------------------------------------}
  3051. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  3052. {---------------------------------------------------------------------------}
  3053. PROCEDURE THistory.Store (Var S: TStream);
  3054. BEGIN
  3055. TView.Store(S); { TView.Store called }
  3056. PutPeerViewPtr(S, Link); { Store link view }
  3057. S.Write(HistoryId, SizeOf(HistoryId)); { Store history id }
  3058. END;
  3059. {--THistory-----------------------------------------------------------------}
  3060. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  3061. {---------------------------------------------------------------------------}
  3062. PROCEDURE THistory.HandleEvent (Var Event: TEvent);
  3063. VAR C: Word; Rslt: String; R, P: TRect; HistoryWindow: PHistoryWindow;
  3064. BEGIN
  3065. Inherited HandleEvent(Event); { Call ancestor }
  3066. If (Link = Nil) Then Exit; { No link view exits }
  3067. If (Event.What = evMouseDown) OR { Mouse down event }
  3068. ((Event.What = evKeyDown) AND
  3069. (CtrlToArrow(Event.KeyCode) = kbDown) AND { Down arrow key }
  3070. (Link^.State AND sfFocused <> 0)) Then Begin { Link view selected }
  3071. If NOT Link^.Focus Then Begin
  3072. ClearEvent(Event); { Event was handled }
  3073. Exit; { Now exit }
  3074. End;
  3075. RecordHistory(Link^.Data^); { Record current data }
  3076. Link^.GetBounds(R); { Get view bounds }
  3077. Dec(R.A.X); { One char in from us }
  3078. Inc(R.B.X); { One char short of us }
  3079. Inc(R.B.Y, 7); { Seven lines down }
  3080. Dec(R.A.Y,1); { One line below us }
  3081. Owner^.GetExtent(P); { Get owner extents }
  3082. R.Intersect(P); { Intersect views }
  3083. Dec(R.B.Y,1); { Shorten length by one }
  3084. HistoryWindow := InitHistoryWindow(R); { Create history window }
  3085. If (HistoryWindow <> Nil) Then Begin { Window crested okay }
  3086. C := Owner^.ExecView(HistoryWindow); { Execute this window }
  3087. If (C = cmOk) Then Begin { Result was okay }
  3088. Rslt := HistoryWindow^.GetSelection; { Get history selection }
  3089. If Length(Rslt) > Link^.MaxLen Then
  3090. SetLength(Rslt, Link^.MaxLen); { Hold new length }
  3091. Link^.Data^ := Rslt; { Hold new selection }
  3092. Link^.SelectAll(True); { Select all string }
  3093. Link^.DrawView; { Redraw link view }
  3094. End;
  3095. Dispose(HistoryWindow, Done); { Dispose of window }
  3096. End;
  3097. ClearEvent(Event); { Event was handled }
  3098. End Else If (Event.What = evBroadcast) Then { Broadcast event }
  3099. If ((Event.Command = cmReleasedFocus) AND
  3100. (Event.InfoPtr = Link)) OR
  3101. (Event.Command = cmRecordHistory) Then { Record command }
  3102. RecordHistory(Link^.Data^); { Record the history }
  3103. END;
  3104. {****************************************************************************}
  3105. { TBrowseButton Object }
  3106. {****************************************************************************}
  3107. {****************************************************************************}
  3108. { TBrowseButton.Init }
  3109. {****************************************************************************}
  3110. constructor TBrowseButton.Init(var Bounds: TRect; ATitle: TTitleStr;
  3111. ACommand: Word; AFlags: Byte; ALink: PBrowseInputLine);
  3112. begin
  3113. if not inherited Init(Bounds,ATitle,ACommand,AFlags) then
  3114. Fail;
  3115. Link := ALink;
  3116. end;
  3117. {****************************************************************************}
  3118. { TBrowseButton.Load }
  3119. {****************************************************************************}
  3120. constructor TBrowseButton.Load(var S: TStream);
  3121. begin
  3122. if not inherited Load(S) then
  3123. Fail;
  3124. GetPeerViewPtr(S,Link);
  3125. end;
  3126. {****************************************************************************}
  3127. { TBrowseButton.Press }
  3128. {****************************************************************************}
  3129. procedure TBrowseButton.Press;
  3130. var
  3131. E: TEvent;
  3132. begin
  3133. Message(Owner, evBroadcast, cmRecordHistory, nil);
  3134. if Flags and bfBroadcast <> 0 then
  3135. Message(Owner, evBroadcast, Command, Link) else
  3136. begin
  3137. E.What := evCommand;
  3138. E.Command := Command;
  3139. E.InfoPtr := Link;
  3140. PutEvent(E);
  3141. end;
  3142. end;
  3143. {****************************************************************************}
  3144. { TBrowseButton.Store }
  3145. {****************************************************************************}
  3146. procedure TBrowseButton.Store(var S: TStream);
  3147. begin
  3148. inherited Store(S);
  3149. PutPeerViewPtr(S,Link);
  3150. end;
  3151. {****************************************************************************}
  3152. { TBrowseInputLine Object }
  3153. {****************************************************************************}
  3154. {****************************************************************************}
  3155. { TBrowseInputLine.Init }
  3156. {****************************************************************************}
  3157. constructor TBrowseInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer; AHistory: Sw_Word);
  3158. begin
  3159. if not inherited Init(Bounds,AMaxLen) then
  3160. Fail;
  3161. History := AHistory;
  3162. end;
  3163. {****************************************************************************}
  3164. { TBrowseInputLine.Load }
  3165. {****************************************************************************}
  3166. constructor TBrowseInputLine.Load(var S: TStream);
  3167. begin
  3168. if not inherited Load(S) then
  3169. Fail;
  3170. S.Read(History,SizeOf(History));
  3171. if (S.Status <> stOk) then
  3172. Fail;
  3173. end;
  3174. {****************************************************************************}
  3175. { TBrowseInputLine.DataSize }
  3176. {****************************************************************************}
  3177. function TBrowseInputLine.DataSize: Sw_Word;
  3178. begin
  3179. DataSize := SizeOf(TBrowseInputLineRec);
  3180. end;
  3181. {****************************************************************************}
  3182. { TBrowseInputLine.GetData }
  3183. {****************************************************************************}
  3184. procedure TBrowseInputLine.GetData(var Rec);
  3185. var
  3186. LocalRec: TBrowseInputLineRec absolute Rec;
  3187. begin
  3188. if (Validator = nil) or
  3189. (Validator^.Transfer(Data^,@LocalRec.Text, vtGetData) = 0) then
  3190. begin
  3191. FillChar(LocalRec.Text, DataSize, #0);
  3192. Move(Data^, LocalRec.Text, Length(Data^) + 1);
  3193. end;
  3194. LocalRec.History := History;
  3195. end;
  3196. {****************************************************************************}
  3197. { TBrowseInputLine.SetData }
  3198. {****************************************************************************}
  3199. procedure TBrowseInputLine.SetData(var Rec);
  3200. var
  3201. LocalRec: TBrowseInputLineRec absolute Rec;
  3202. begin
  3203. if (Validator = nil) or
  3204. (Validator^.Transfer(Data^, @LocalRec.Text, vtSetData) = 0) then
  3205. Move(LocalRec.Text, Data^[0], MaxLen + 1);
  3206. History := LocalRec.History;
  3207. SelectAll(True);
  3208. end;
  3209. {****************************************************************************}
  3210. { TBrowseInputLine.Store }
  3211. {****************************************************************************}
  3212. procedure TBrowseInputLine.Store(var S: TStream);
  3213. begin
  3214. inherited Store(S);
  3215. S.Write(History,SizeOf(History));
  3216. end;
  3217. {****************************************************************************}
  3218. { TCommandCheckBoxes Object }
  3219. {****************************************************************************}
  3220. {****************************************************************************}
  3221. { TCommandCheckBoxes.Init }
  3222. {****************************************************************************}
  3223. constructor TCommandCheckBoxes.Init (var Bounds : TRect;
  3224. ACommandStrings : PCommandSItem);
  3225. var StartSItem, S : PSItem;
  3226. CItems : PCommandSItem;
  3227. i : Sw_Integer;
  3228. begin
  3229. if ACommandStrings = nil then
  3230. Fail;
  3231. { set up string list }
  3232. StartSItem := NewSItem(ACommandStrings^.Value,nil);
  3233. S := StartSItem;
  3234. CItems := ACommandStrings^.Next;
  3235. while (CItems <> nil) do begin
  3236. S^.Next := NewSItem(CItems^.Value,nil);
  3237. S := S^.Next;
  3238. CItems := CItems^.Next;
  3239. end;
  3240. { construct check boxes }
  3241. if not TCheckBoxes.Init(Bounds,StartSItem) then begin
  3242. while (StartSItem <> nil) do begin
  3243. S := StartSItem;
  3244. StartSItem := StartSItem^.Next;
  3245. if (S^.Value <> nil) then
  3246. DisposeStr(S^.Value);
  3247. Dispose(S);
  3248. end;
  3249. Fail;
  3250. end;
  3251. { set up CommandList and dispose of memory used by ACommandList }
  3252. i := 0;
  3253. while (ACommandStrings <> nil) do begin
  3254. CommandList[i] := ACommandStrings^.Command;
  3255. CItems := ACommandStrings;
  3256. ACommandStrings := ACommandStrings^.Next;
  3257. Dispose(CItems);
  3258. Inc(i);
  3259. end;
  3260. end;
  3261. {****************************************************************************}
  3262. { TCommandCheckBoxes.Load }
  3263. {****************************************************************************}
  3264. constructor TCommandCheckBoxes.Load (var S : TStream);
  3265. begin
  3266. if not TCheckBoxes.Load(S) then
  3267. Fail;
  3268. S.Read(CommandList,SizeOf(CommandList));
  3269. if (S.Status <> stOk) then begin
  3270. TCheckBoxes.Done;
  3271. Fail;
  3272. end;
  3273. end;
  3274. {****************************************************************************}
  3275. { TCommandCheckBoxes.Press }
  3276. {****************************************************************************}
  3277. procedure TCommandCheckBoxes.Press (Item : Sw_Integer);
  3278. var Temp : Sw_Integer;
  3279. begin
  3280. Temp := Value;
  3281. TCheckBoxes.Press(Item);
  3282. if (Value <> Temp) then { value changed - notify peers }
  3283. Message(Owner,evCommand,CommandList[Item],@Value);
  3284. end;
  3285. {****************************************************************************}
  3286. { TCommandCheckBoxes.Store }
  3287. {****************************************************************************}
  3288. procedure TCommandCheckBoxes.Store (var S : TStream);
  3289. begin
  3290. TCheckBoxes.Store(S);
  3291. S.Write(CommandList,SizeOf(CommandList));
  3292. end;
  3293. {****************************************************************************}
  3294. { TCommandIcon Object }
  3295. {****************************************************************************}
  3296. {****************************************************************************}
  3297. { TCommandIcon.Init }
  3298. {****************************************************************************}
  3299. constructor TCommandIcon.Init (var Bounds : TRect; AText : String;
  3300. ACommand : Word);
  3301. begin
  3302. if not TStaticText.Init(Bounds,AText) then
  3303. Fail;
  3304. Options := Options or ofPostProcess;
  3305. Command := ACommand;
  3306. end;
  3307. {****************************************************************************}
  3308. { TCommandIcon.HandleEvent }
  3309. {****************************************************************************}
  3310. procedure TCommandIcon.HandleEvent (var Event : TEvent);
  3311. begin
  3312. if ((Event.What = evMouseDown) and MouseInView(MouseWhere)) then begin
  3313. ClearEvent(Event);
  3314. Message(Owner,evCommand,Command,nil);
  3315. end;
  3316. TStaticText.HandleEvent(Event);
  3317. end;
  3318. {****************************************************************************}
  3319. { TCommandInputLine Object }
  3320. {****************************************************************************}
  3321. {****************************************************************************}
  3322. { TCommandInputLine.Changed }
  3323. {****************************************************************************}
  3324. {procedure TCommandInputLine.Changed;
  3325. begin
  3326. Message(Owner,evBroadcast,cmInputLineChanged,@Self);
  3327. end; }
  3328. {****************************************************************************}
  3329. { TCommandInputLine.HandleEvent }
  3330. {****************************************************************************}
  3331. {procedure TCommandInputLine.HandleEvent (var Event : TEvent);
  3332. var E : TEvent;
  3333. begin
  3334. E := Event;
  3335. TBSDInputLine.HandleEvent(Event);
  3336. if ((E.What and evKeyBoard = evKeyBoard) and (Event.KeyCode = kbEnter))
  3337. then Changed;
  3338. end; }
  3339. {****************************************************************************}
  3340. { TCommandRadioButtons Object }
  3341. {****************************************************************************}
  3342. {****************************************************************************}
  3343. { TCommandRadioButtons.Init }
  3344. {****************************************************************************}
  3345. constructor TCommandRadioButtons.Init (var Bounds : TRect;
  3346. ACommandStrings : PCommandSItem);
  3347. var
  3348. StartSItem, S : PSItem;
  3349. CItems : PCommandSItem;
  3350. i : Sw_Integer;
  3351. begin
  3352. if ACommandStrings = nil
  3353. then Fail;
  3354. { set up string list }
  3355. StartSItem := NewSItem(ACommandStrings^.Value,nil);
  3356. S := StartSItem;
  3357. CItems := ACommandStrings^.Next;
  3358. while (CItems <> nil) do begin
  3359. S^.Next := NewSItem(CItems^.Value,nil);
  3360. S := S^.Next;
  3361. CItems := CItems^.Next;
  3362. end;
  3363. { construct check boxes }
  3364. if not TRadioButtons.Init(Bounds,StartSItem) then begin
  3365. while (StartSItem <> nil) do begin
  3366. S := StartSItem;
  3367. StartSItem := StartSItem^.Next;
  3368. if (S^.Value <> nil) then
  3369. DisposeStr(S^.Value);
  3370. Dispose(S);
  3371. end;
  3372. Fail;
  3373. end;
  3374. { set up command list }
  3375. i := 0;
  3376. while (ACommandStrings <> nil) do begin
  3377. CommandList[i] := ACommandStrings^.Command;
  3378. CItems := ACommandStrings;
  3379. ACommandStrings := ACommandStrings^.Next;
  3380. Dispose(CItems);
  3381. Inc(i);
  3382. end;
  3383. end;
  3384. {****************************************************************************}
  3385. { TCommandRadioButtons.Load }
  3386. {****************************************************************************}
  3387. constructor TCommandRadioButtons.Load (var S : TStream);
  3388. begin
  3389. if not TRadioButtons.Load(S) then
  3390. Fail;
  3391. S.Read(CommandList,SizeOf(CommandList));
  3392. if (S.Status <> stOk) then begin
  3393. TRadioButtons.Done;
  3394. Fail;
  3395. end;
  3396. end;
  3397. {****************************************************************************}
  3398. { TCommandRadioButtons.MoveTo }
  3399. {****************************************************************************}
  3400. procedure TCommandRadioButtons.MovedTo (Item : Sw_Integer);
  3401. var Temp : Sw_Integer;
  3402. begin
  3403. Temp := Value;
  3404. TRadioButtons.MovedTo(Item);
  3405. if (Value <> Temp) then { value changed - notify peers }
  3406. Message(Owner,evCommand,CommandList[Item],@Value);
  3407. end;
  3408. {****************************************************************************}
  3409. { TCommandRadioButtons.Press }
  3410. {****************************************************************************}
  3411. procedure TCommandRadioButtons.Press (Item : Sw_Integer);
  3412. var Temp : Sw_Integer;
  3413. begin
  3414. Temp := Value;
  3415. TRadioButtons.Press(Item);
  3416. if (Value <> Temp) then { value changed - notify peers }
  3417. Message(Owner,evCommand,CommandList[Item],@Value);
  3418. end;
  3419. {****************************************************************************}
  3420. { TCommandRadioButtons.Store }
  3421. {****************************************************************************}
  3422. procedure TCommandRadioButtons.Store (var S : TStream);
  3423. begin
  3424. TRadioButtons.Store(S);
  3425. S.Write(CommandList,SizeOf(CommandList));
  3426. end;
  3427. {****************************************************************************}
  3428. { TEditListBox Object }
  3429. {****************************************************************************}
  3430. {****************************************************************************}
  3431. { TEditListBox.Init }
  3432. {****************************************************************************}
  3433. constructor TEditListBox.Init (Bounds : TRect; ANumCols: Word;
  3434. AVScrollBar : PScrollBar);
  3435. begin
  3436. if not inherited Init(Bounds,ANumCols,AVScrollBar)
  3437. then Fail;
  3438. CurrentField := 1;
  3439. end;
  3440. {****************************************************************************}
  3441. { TEditListBox.Load }
  3442. {****************************************************************************}
  3443. constructor TEditListBox.Load (var S : TStream);
  3444. begin
  3445. if not inherited Load(S)
  3446. then Fail;
  3447. CurrentField := 1;
  3448. end;
  3449. {****************************************************************************}
  3450. { TEditListBox.EditField }
  3451. {****************************************************************************}
  3452. procedure TEditListBox.EditField (var Event : TEvent);
  3453. var R : TRect;
  3454. InputLine : PModalInputLine;
  3455. Data : String;
  3456. begin
  3457. R.Assign(StartColumn,(Origin.Y + Focused - TopItem),
  3458. (StartColumn + FieldWidth + 2),(Origin.Y + Focused - TopItem + 1));
  3459. Owner^.MakeGlobal(R.A,R.A);
  3460. Owner^.MakeGlobal(R.B,R.B);
  3461. InputLine := New(PModalInputLine,Init(R,FieldWidth));
  3462. InputLine^.SetValidator(FieldValidator);
  3463. if InputLine <> nil
  3464. then begin
  3465. { Use TInputLine^.SetData so that data validation occurs }
  3466. { because TInputLine.Data is allocated memory large enough }
  3467. { to hold a string of MaxLen. It is also faster. }
  3468. GetField(InputLine);
  3469. if (Application^.ExecView(InputLine) = cmOk)
  3470. then SetField(InputLine);
  3471. Dispose(InputLine,done);
  3472. end;
  3473. end;
  3474. {****************************************************************************}
  3475. { TEditListBox.FieldValidator }
  3476. {****************************************************************************}
  3477. function TEditListBox.FieldValidator : PValidator;
  3478. { In a multiple field listbox FieldWidth should return the width }
  3479. { appropriate for Field. The default is an inputline for editing }
  3480. { a string of length large enough to fill the listbox field. }
  3481. begin
  3482. FieldValidator := nil;
  3483. end;
  3484. {****************************************************************************}
  3485. { TEditListBox.FieldWidth }
  3486. {****************************************************************************}
  3487. function TEditListBox.FieldWidth : Integer;
  3488. { In a multiple field listbox FieldWidth should return the width }
  3489. { appropriate for CurrentField. }
  3490. begin
  3491. FieldWidth := Size.X - 2;
  3492. end;
  3493. {****************************************************************************}
  3494. { TEditListBox.GetField }
  3495. {****************************************************************************}
  3496. procedure TEditListBox.GetField (InputLine : PInputLine);
  3497. { Places a string appropriate to Field and Focused into InputLine that }
  3498. { will be edited. Override this method for complex data types. }
  3499. begin
  3500. InputLine^.SetData(PString(List^.At(Focused))^);
  3501. end;
  3502. {****************************************************************************}
  3503. { TEditListBox.GetPalette }
  3504. {****************************************************************************}
  3505. function TEditListBox.GetPalette : PPalette;
  3506. begin
  3507. GetPalette := inherited GetPalette;
  3508. end;
  3509. {****************************************************************************}
  3510. { TEditListBox.HandleEvent }
  3511. {****************************************************************************}
  3512. procedure TEditListBox.HandleEvent (var Event : TEvent);
  3513. begin
  3514. if (Event.What = evKeyboard) and (Event.KeyCode = kbAltE)
  3515. then begin { edit field }
  3516. EditField(Event);
  3517. DrawView;
  3518. ClearEvent(Event);
  3519. end;
  3520. inherited HandleEvent(Event);
  3521. end;
  3522. {****************************************************************************}
  3523. { TEditListBox.SetField }
  3524. {****************************************************************************}
  3525. procedure TEditListBox.SetField (InputLine : PInputLine);
  3526. { Override this method for field types other than PStrings. }
  3527. var Item : PString;
  3528. begin
  3529. Item := NewStr(InputLine^.Data^);
  3530. if Item <> nil
  3531. then begin
  3532. List^.AtFree(Focused);
  3533. List^.Insert(Item);
  3534. SetFocusedItem(Item);
  3535. end;
  3536. end;
  3537. {****************************************************************************}
  3538. { TEditListBox.StartColumn }
  3539. {****************************************************************************}
  3540. function TEditListBox.StartColumn : Integer;
  3541. begin
  3542. StartColumn := Origin.X;
  3543. end;
  3544. {****************************************************************************}
  3545. { TListDlg Object }
  3546. {****************************************************************************}
  3547. {****************************************************************************}
  3548. { TListDlg.Init }
  3549. {****************************************************************************}
  3550. constructor TListDlg.Init (ATitle : TTitleStr; Items:
  3551. String; AButtons: Word; AListBox: PListBox; AEditCommand, ANewCommand :
  3552. Word);
  3553. var
  3554. Bounds: TRect;
  3555. b: Byte;
  3556. ButtonCount: Byte;
  3557. i, j, Gap, Line: Integer;
  3558. Scrollbar: PScrollbar;
  3559. HasFrame: Boolean;
  3560. HasButtons: Boolean;
  3561. HasScrollBar: Boolean;
  3562. HasItems: Boolean;
  3563. begin
  3564. if AListBox = nil then
  3565. Fail
  3566. else
  3567. ListBox := AListBox;
  3568. HasFrame := ((AButtons and ldNoFrame) = 0);
  3569. HasButtons := ((AButtons and ldAllButtons) <> 0);
  3570. HasScrollBar := ((AButtons and ldNoScrollBar) = 0);
  3571. HasItems := (Items <> '');
  3572. ButtonCount := 2;
  3573. for b := 0 to 3 do
  3574. if (AButtons and ($0001 shl 1)) <> 0 then
  3575. Inc(ButtonCount);
  3576. { Make sure dialog is large enough for buttons }
  3577. ListBox^.GetExtent(Bounds);
  3578. Bounds.Move(ListBox^.Origin.X,ListBox^.Origin.Y);
  3579. if HasFrame then
  3580. begin
  3581. Inc(Bounds.B.X,2);
  3582. Inc(Bounds.B.Y,2);
  3583. end;
  3584. if HasButtons then
  3585. begin
  3586. Inc(Bounds.B.X,14);
  3587. if Bounds.B.Y < (ButtonCount * 2) + 4 then
  3588. Bounds.B.Y := (ButtonCount * 2) + 5;
  3589. end;
  3590. if HasItems then
  3591. Inc(Bounds.B.Y,1);
  3592. if not TDialog.Init(Bounds,ATitle) then
  3593. Fail;
  3594. NewCommand := ANewCommand;
  3595. EditCommand := AEditCommand;
  3596. Options := Options or ofNewEditDelete;
  3597. if (not HasFrame) and (Frame <> nil) then
  3598. begin
  3599. Delete(Frame);
  3600. Dispose(Frame,Done);
  3601. Frame := nil;
  3602. Options := Options and not ofFramed;
  3603. end;
  3604. HelpCtx := hcListDlg;
  3605. { position and insert ListBox }
  3606. ListBox := AListBox;
  3607. Insert(ListBox);
  3608. if HasItems then
  3609. if HasFrame then
  3610. ListBox^.MoveTo(2,2)
  3611. else ListBox^.MoveTo(0,2)
  3612. else
  3613. if HasFrame then
  3614. ListBox^.MoveTo(1,1)
  3615. else ListBox^.MoveTo(0,0);
  3616. if HasButtons then
  3617. if ListBox^.Size.Y < (ButtonCount * 2) then
  3618. ListBox^.GrowTo(ListBox^.Size.X,ButtonCount * 2);
  3619. { do Items }
  3620. if HasItems then
  3621. begin
  3622. Bounds.Assign(1,1,CStrLen(Items)+2,2);
  3623. Insert(New(PLabel,Init(Bounds,Items,ListBox)));
  3624. end;
  3625. { do scrollbar }
  3626. if HasScrollBar then
  3627. begin
  3628. Bounds.Assign(ListBox^.Size.X+ListBox^.Origin.X,ListBox^.Origin.Y,
  3629. ListBox^.Size.X + ListBox^.Origin.X + 1,
  3630. ListBox^.Size.Y + ListBox^.Origin.Y { origin });
  3631. ScrollBar := New(PScrollBar,Init(Bounds));
  3632. Bounds.Assign(Origin.X,Origin.Y,Origin.X + Size.X + 1, Origin.Y + Size.Y);
  3633. ChangeBounds(Bounds);
  3634. Insert(Scrollbar);
  3635. end;
  3636. if HasButtons then
  3637. begin { do buttons }
  3638. j := $0001;
  3639. Gap := 0;
  3640. for i := 0 to 3 do
  3641. if ((j shl i) and AButtons) <> 0 then
  3642. Inc(Gap);
  3643. Gap := ((Size.Y - 2) div (Gap + 2));
  3644. if Gap < 2 then
  3645. Gap := 2;
  3646. { Insert Buttons }
  3647. Line := 2;
  3648. if (AButtons and ldNew) = ldNew then
  3649. begin
  3650. Insert(NewButton(Size.X - 12,Line,10,2,'~N~ew',cmNew,hcInsert,bfNormal));
  3651. Inc(Line,Gap);
  3652. end;
  3653. if (AButtons and ldEdit) = ldEdit then
  3654. begin
  3655. Insert(NewButton(Size.X - 12,Line,10,2,'~E~dit',cmEdit,hcEdit,
  3656. bfNormal));
  3657. Inc(Line,Gap);
  3658. end;
  3659. if (AButtons and ldDelete) = ldDelete then
  3660. begin
  3661. Insert(NewButton(Size.X - 12,Line,10,2,'~D~elete',cmDelete,hcDelete,
  3662. bfNormal));
  3663. Inc(Line,Gap);
  3664. end;
  3665. Insert(NewButton(Size.X - 12,Line,10,2,'O~k~',cmOK,hcOk,bfDefault or
  3666. bfNormal));
  3667. Inc(Line,Gap);
  3668. Insert(NewButton(Size.X - 12,Line,10,2,'Cancel',cmCancel,hcCancel,
  3669. bfNormal));
  3670. if (AButtons and ldHelp) = ldHelp then
  3671. begin
  3672. Inc(Line,Gap);
  3673. Insert(NewButton(Size.X - 12,Line,10,2,'~H~elp',cmHelp,hcNoContext,
  3674. bfNormal));
  3675. end;
  3676. end;
  3677. if HasFrame and ((AButtons and ldAllIcons) <> 0) then
  3678. begin
  3679. Line := 2;
  3680. if (AButtons and ldNewIcon) = ldNewIcon then
  3681. begin
  3682. Bounds.Assign(Line,Size.Y-1,Line+5,Size.Y);
  3683. Insert(New(PCommandIcon,Init(Bounds,' Ins ',cmNew)));
  3684. Inc(Line,5);
  3685. if (AButtons and (ldEditIcon or ldDeleteIcon)) <> 0 then
  3686. begin
  3687. Bounds.Assign(Line,Size.Y-1,Line+1,Size.Y);
  3688. Insert(New(PStaticText,Init(Bounds,'/')));
  3689. Inc(Line,1);
  3690. end;
  3691. end;
  3692. if (AButtons and ldEditIcon) = ldEditIcon then
  3693. begin
  3694. Bounds.Assign(Line,Size.Y-1,Line+6,Size.Y);
  3695. Insert(New(PCommandIcon,Init(Bounds,' Edit ',cmEdit)));
  3696. Inc(Line,6);
  3697. if (AButtons and ldDeleteIcon) <> 0 then
  3698. begin
  3699. Bounds.Assign(Line,Size.Y-1,Line+1,Size.Y);
  3700. Insert(New(PStaticText,Init(Bounds,'/')));
  3701. Inc(Line,1);
  3702. end;
  3703. end;
  3704. if (AButtons and ldNewIcon) = ldNewIcon then
  3705. begin
  3706. Bounds.Assign(Line,Size.Y-1,Line+5,Size.Y);
  3707. Insert(New(PCommandIcon,Init(Bounds,' Del ',cmDelete)));
  3708. end;
  3709. end;
  3710. { Set focus to list boLine when dialog opens }
  3711. SelectNext(False);
  3712. end;
  3713. {****************************************************************************}
  3714. { TListDlg.Load }
  3715. {****************************************************************************}
  3716. constructor TListDlg.Load (var S : TStream);
  3717. begin
  3718. if not TDialog.Load(S) then
  3719. Fail;
  3720. S.Read(NewCommand,SizeOf(NewCommand));
  3721. S.Read(EditCommand,SizeOf(EditCommand));
  3722. GetSubViewPtr(S,ListBox);
  3723. end;
  3724. {****************************************************************************}
  3725. { TListDlg.HandleEvent }
  3726. {****************************************************************************}
  3727. procedure TListDlg.HandleEvent (var Event : TEvent);
  3728. const
  3729. TargetCommands: TCommandSet = [cmNew, cmEdit, cmDelete];
  3730. begin
  3731. if ((Event.What and evCommand) <> 0) and
  3732. (Event.Command in TargetCommands) then
  3733. case Event.Command of
  3734. cmDelete:
  3735. if Options and ofDelete = ofDelete then
  3736. begin
  3737. ListBox^.FreeFocusedItem;
  3738. ListBox^.DrawView;
  3739. ClearEvent(Event);
  3740. end;
  3741. cmNew:
  3742. if Options and ofNew = ofNew then
  3743. begin
  3744. Message(Application,evCommand,NewCommand,nil);
  3745. ListBox^.SetRange(ListBox^.List^.Count);
  3746. ListBox^.DrawView;
  3747. ClearEvent(Event);
  3748. end;
  3749. cmEdit:
  3750. if Options and ofEdit = ofEdit then
  3751. begin
  3752. Message(Application,evCommand,EditCommand,ListBox^.GetFocusedItem);
  3753. ListBox^.DrawView;
  3754. ClearEvent(Event);
  3755. end;
  3756. end;
  3757. if (Event.What and evBroadcast > 0) and
  3758. (Event.Command = cmListItemSelected) then
  3759. begin { use PutEvent instead of Message so that a window list box works }
  3760. Event.What := evCommand;
  3761. Event.Command := cmOk;
  3762. Event.InfoPtr := nil;
  3763. PutEvent(Event);
  3764. end;
  3765. TDialog.HandleEvent(Event);
  3766. end;
  3767. {****************************************************************************}
  3768. { TListDlg.Store }
  3769. {****************************************************************************}
  3770. procedure TListDlg.Store (var S : TStream);
  3771. begin
  3772. TDialog.Store(S);
  3773. S.Write(NewCommand,SizeOf(NewCommand));
  3774. S.Write(EditCommand,SizeOf(EditCommand));
  3775. PutSubViewPtr(S,ListBox);
  3776. end;
  3777. {****************************************************************************}
  3778. { TModalInputLine Object }
  3779. {****************************************************************************}
  3780. {****************************************************************************}
  3781. { TModalInputLine.Execute }
  3782. {****************************************************************************}
  3783. function TModalInputLine.Execute : Word;
  3784. var Event : TEvent;
  3785. begin
  3786. repeat
  3787. EndState := 0;
  3788. repeat
  3789. GetEvent(Event);
  3790. HandleEvent(Event);
  3791. if Event.What <> evNothing
  3792. then Owner^.EventError(Event); { may change this to ClearEvent }
  3793. until (EndState <> 0);
  3794. until Valid(EndState);
  3795. Execute := EndState;
  3796. end;
  3797. {****************************************************************************}
  3798. { TModalInputLine.HandleEvent }
  3799. {****************************************************************************}
  3800. procedure TModalInputLine.HandleEvent (var Event : TEvent);
  3801. begin
  3802. case Event.What of
  3803. evKeyboard : case Event.KeyCode of
  3804. kbUp, kbDown : EndModal(cmCancel);
  3805. kbEnter : EndModal(cmOk);
  3806. else inherited HandleEvent(Event);
  3807. end;
  3808. evMouse : if MouseInView(Event.Where)
  3809. then inherited HandleEvent(Event)
  3810. else EndModal(cmCancel);
  3811. else inherited HandleEvent(Event);
  3812. end;
  3813. end;
  3814. {****************************************************************************}
  3815. { TModalInputLine.SetState }
  3816. {****************************************************************************}
  3817. procedure TModalInputLine.SetState (AState : Word; Enable : Boolean);
  3818. var Pos : Integer;
  3819. begin
  3820. if (AState = sfSelected)
  3821. then begin
  3822. Pos := CurPos;
  3823. inherited SetState(AState,Enable);
  3824. CurPos := Pos;
  3825. SelStart := CurPos;
  3826. SelEnd := CurPos;
  3827. BlockCursor;
  3828. DrawView;
  3829. end
  3830. else inherited SetState(AState,Enable);
  3831. end;
  3832. {***************************************************************************}
  3833. { INTERFACE ROUTINES }
  3834. {***************************************************************************}
  3835. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3836. { ITEM STRING ROUTINES }
  3837. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3838. {---------------------------------------------------------------------------}
  3839. { NewSItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  3840. {---------------------------------------------------------------------------}
  3841. FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;
  3842. VAR Item: PSItem;
  3843. BEGIN
  3844. New(Item); { Allocate item }
  3845. Item^.Value := NewStr(Str); { Hold item string }
  3846. Item^.Next := ANext; { Chain the ptr }
  3847. NewSItem := Item; { Return item }
  3848. END;
  3849. {****************************************************************************}
  3850. { NewCommandSItem }
  3851. {****************************************************************************}
  3852. function NewCommandSItem (Str : String; ACommand : Word;
  3853. ANext : PCommandSItem) : PCommandSItem;
  3854. var Temp : PCommandSItem;
  3855. begin
  3856. New(Temp);
  3857. if (Temp <> nil) then
  3858. begin
  3859. Temp^.Value := Str;
  3860. Temp^.Command := ACommand;
  3861. Temp^.Next := ANext;
  3862. end;
  3863. NewCommandSItem := Temp;
  3864. end;
  3865. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3866. { DIALOG OBJECT REGISTRATION ROUTINES }
  3867. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3868. {---------------------------------------------------------------------------}
  3869. { RegisterDialogs -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  3870. {---------------------------------------------------------------------------}
  3871. PROCEDURE RegisterDialogs;
  3872. BEGIN
  3873. RegisterType(RDialog); { Register dialog }
  3874. RegisterType(RInputLine); { Register inputline }
  3875. RegisterType(RButton); { Register button }
  3876. RegisterType(RCluster); { Register cluster }
  3877. RegisterType(RRadioButtons); { Register radiobutton }
  3878. RegisterType(RCheckBoxes); { Register check boxes }
  3879. RegisterType(RMultiCheckBoxes); { Register multi boxes }
  3880. RegisterType(RListBox); { Register list box }
  3881. RegisterType(RStaticText); { Register static text }
  3882. RegisterType(RLabel); { Register label }
  3883. RegisterType(RHistory); { Register history }
  3884. RegisterType(RParamText); { Register parm text }
  3885. RegisterType(RCommandCheckBoxes);
  3886. RegisterType(RCommandIcon);
  3887. RegisterType(RCommandRadioButtons);
  3888. RegisterType(REditListBox);
  3889. RegisterType(RModalInputLine);
  3890. RegisterType(RListDlg);
  3891. END;
  3892. END.
  3893. {
  3894. $Log$
  3895. Revision 1.22 2002-10-17 13:27:53 pierre
  3896. * fix TCluster.Get/SetData on big endian machines
  3897. Revision 1.21 2002/10/17 11:24:16 pierre
  3898. * Clean up the Load/Store routines so they are endian independent
  3899. Revision 1.20 2002/09/22 19:42:23 hajny
  3900. + FPC/2 support added
  3901. Revision 1.19 2002/09/09 08:14:47 pierre
  3902. * remove virtual modifer from store methods
  3903. Revision 1.18 2002/09/07 15:06:36 peter
  3904. * old logs removed and tabs fixed
  3905. Revision 1.17 2002/05/31 12:35:21 pierre
  3906. * use graph mode to display button title
  3907. Revision 1.16 2002/05/24 21:00:10 pierre
  3908. * correct cursor position for TInputLine
  3909. Revision 1.15 2002/05/23 12:16:11 pierre
  3910. * fix textmode button to be displayed like in TV
  3911. Revision 1.14 2002/05/23 09:06:53 pierre
  3912. * use normal cursor for textmode TInputLine
  3913. Revision 1.13 2002/05/16 20:36:24 pierre
  3914. * break lines of static text if too long
  3915. }
  3916. {******************[ REVISION HISTORY ]********************}
  3917. { Version Date Fix }
  3918. { ------- --------- --------------------------------- }
  3919. { 1.00 11 Nov 96 First DOS/DPMI platform release. }
  3920. { 1.10 13 Jul 97 Windows platform code added. }
  3921. { 1.20 29 Aug 97 Platform.inc sort added. }
  3922. { 1.30 13 Oct 97 Delphi 2 32 bit code added. }
  3923. { 1.40 05 May 98 Virtual pascal 2.0 code added. }
  3924. { 1.50 27 Oct 99 All objects completed and checked }
  3925. { 1.51 03 Nov 99 FPC windows support added }
  3926. { 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
  3927. {**********************************************************}