dialogs.pas 164 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222
  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. { 16 and 32 Bit compilers }
  25. { DOS - Turbo Pascal 7.0 + (16 Bit) }
  26. { DPMI - Turbo Pascal 7.0 + (16 Bit) }
  27. { - FPC 0.9912+ (GO32V2) (32 Bit) }
  28. { WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
  29. { - Delphi 1.0+ (16 Bit) }
  30. { WIN95/NT - Delphi 2.0+ (32 Bit) }
  31. { - Virtual Pascal 2.0+ (32 Bit) }
  32. { - Speedsoft Sybil 2.0+ (32 Bit) }
  33. { - FPC 0.9912+ (32 Bit) }
  34. { OS2 - Virtual Pascal 1.0+ (32 Bit) }
  35. { }
  36. {******************[ REVISION HISTORY ]********************}
  37. { Version Date Fix }
  38. { ------- --------- --------------------------------- }
  39. { 1.00 11 Nov 96 First DOS/DPMI platform release. }
  40. { 1.10 13 Jul 97 Windows platform code added. }
  41. { 1.20 29 Aug 97 Platform.inc sort added. }
  42. { 1.30 13 Oct 97 Delphi 2 32 bit code added. }
  43. { 1.40 05 May 98 Virtual pascal 2.0 code added. }
  44. { 1.50 27 Oct 99 All objects completed and checked }
  45. { 1.51 03 Nov 99 FPC windows support added }
  46. { 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }
  47. {**********************************************************}
  48. UNIT Dialogs;
  49. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  50. INTERFACE
  51. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  52. {====Include file to sort compiler platform out =====================}
  53. {$I Platform.inc}
  54. {====================================================================}
  55. {==== Compiler directives ===========================================}
  56. {$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
  57. {$F-} { Short calls are okay }
  58. {$A+} { Word Align Data }
  59. {$B-} { Allow short circuit boolean evaluations }
  60. {$O+} { This unit may be overlaid }
  61. {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
  62. {$P-} { Normal string variables }
  63. {$N-} { No 80x87 code generation }
  64. {$E+} { Emulation is on }
  65. {$ENDIF}
  66. {$X+} { Extended syntax is ok }
  67. {$R-} { Disable range checking }
  68. {$S-} { Disable Stack Checking }
  69. {$I-} { Disable IO Checking }
  70. {$Q-} { Disable Overflow Checking }
  71. {$V-} { Turn off strict VAR strings }
  72. {====================================================================}
  73. USES
  74. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  75. {$IFNDEF PPC_SPEED} { NON SPEED COMPILER }
  76. {$IFDEF PPC_FPC} { FPC WINDOWS COMPILER }
  77. Windows, { Standard units }
  78. {$ELSE} { OTHER COMPILERS }
  79. WinTypes,WinProcs, { Standard units }
  80. {$ENDIF}
  81. {$ELSE} { SPEEDSOFT COMPILER }
  82. WinBase, WinDef, WinUser, WinGDI, { Standard units }
  83. {$ENDIF}
  84. {$IFDEF PPC_DELPHI} { DELPHI COMPILERS }
  85. Messages, { Standard unit }
  86. {$ENDIF}
  87. {$ENDIF}
  88. {$IFDEF OS_OS2} { OS2 CODE }
  89. OS2Def, OS2Base, OS2PMAPI, { Standard units }
  90. {$ENDIF}
  91. Common, GFVGraph, Objects, Drivers, Views, Validate; { Standard GFV units }
  92. {***************************************************************************}
  93. { PUBLIC CONSTANTS }
  94. {***************************************************************************}
  95. {---------------------------------------------------------------------------}
  96. { COLOUR PALETTE DEFINITIONS }
  97. {---------------------------------------------------------------------------}
  98. CONST
  99. CGrayDialog = #32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47 +
  100. #48#49#50#51#52#53#54#55#56#57#58#59#60#61#62#63;
  101. CBlueDialog = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79 +
  102. #80#81#82#83#84#85#86#87#88#89#90#91#92#92#94#95;
  103. CCyanDialog = #96#97#98#99#100#101#102#103#104#105#106#107#108 +
  104. #109#110#111#112#113#114#115#116#117#118#119#120 +
  105. #121#122#123#124#125#126#127;
  106. CStaticText = #6#7#8#9;
  107. CLabel = #7#8#9#9;
  108. CButton = #10#11#12#13#14#14#14#15;
  109. CCluster = #16#17#18#18#31#6;
  110. CInputLine = #19#19#20#21#14;
  111. CHistory = #22#23;
  112. CHistoryWindow = #19#19#21#24#25#19#20;
  113. CHistoryViewer = #6#6#7#6#6;
  114. CDialog = CGrayDialog; { Default palette }
  115. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  116. {---------------------------------------------------------------------------}
  117. { NEW WIN/NT/OS2 COMMAND CODES }
  118. {---------------------------------------------------------------------------}
  119. CONST
  120. cmTvClusterButton = $2001; { Cluster button cmd id }
  121. {$ENDIF}
  122. {---------------------------------------------------------------------------}
  123. { TDialog PALETTE COLOUR CONSTANTS }
  124. {---------------------------------------------------------------------------}
  125. CONST
  126. dpBlueDialog = 0; { Blue dialog colour }
  127. dpCyanDialog = 1; { Cyan dialog colour }
  128. dpGrayDialog = 2; { Gray dialog colour }
  129. {---------------------------------------------------------------------------}
  130. { TButton FLAGS MASKS }
  131. {---------------------------------------------------------------------------}
  132. CONST
  133. bfNormal = $00; { Normal displayed }
  134. bfDefault = $01; { Default command }
  135. bfLeftJust = $02; { Left just text }
  136. bfBroadcast = $04; { Broadcast command }
  137. bfGrabFocus = $08; { Grab focus }
  138. {---------------------------------------------------------------------------}
  139. { TMultiCheckBoxes FLAGS - (HiByte = Bits LoByte = Mask) }
  140. {---------------------------------------------------------------------------}
  141. CONST
  142. cfOneBit = $0101; { One bit masks }
  143. cfTwoBits = $0203; { Two bit masks }
  144. cfFourBits = $040F; { Four bit masks }
  145. cfEightBits = $08FF; { Eight bit masks }
  146. {---------------------------------------------------------------------------}
  147. { DIALOG BROADCAST COMMANDS }
  148. {---------------------------------------------------------------------------}
  149. CONST
  150. cmRecordHistory = 60; { Record history cmd }
  151. {***************************************************************************}
  152. { RECORD DEFINITIONS }
  153. {***************************************************************************}
  154. {---------------------------------------------------------------------------}
  155. { ITEM RECORD DEFINITION }
  156. {---------------------------------------------------------------------------}
  157. TYPE
  158. PSItem = ^TSItem;
  159. TSItem = RECORD
  160. Value: PString; { Item string }
  161. Next: PSItem; { Next item }
  162. END;
  163. {***************************************************************************}
  164. { OBJECT DEFINITIONS }
  165. {***************************************************************************}
  166. {---------------------------------------------------------------------------}
  167. { TDialog OBJECT - DIALOG OBJECT }
  168. {---------------------------------------------------------------------------}
  169. TYPE
  170. TDialog = OBJECT (TWindow)
  171. CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr);
  172. CONSTRUCTOR Load (Var S: TStream);
  173. FUNCTION GetPalette: PPalette; Virtual;
  174. FUNCTION Valid (Command: Word): Boolean; Virtual;
  175. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  176. END;
  177. PDialog = ^TDialog;
  178. {---------------------------------------------------------------------------}
  179. { TInputLine OBJECT - INPUT LINE OBJECT }
  180. {---------------------------------------------------------------------------}
  181. TYPE
  182. TInputLine = OBJECT (TView)
  183. MaxLen: Integer; { Max input length }
  184. CurPos: Integer; { Cursor position }
  185. FirstPos: Integer; { First position }
  186. SelStart: Integer; { Selected start }
  187. SelEnd: Integer; { Selected end }
  188. Data: PString; { Input line data }
  189. Validator: PValidator; { Validator of view }
  190. CONSTRUCTOR Init (Var Bounds: TRect; AMaxLen: Integer);
  191. CONSTRUCTOR Load (Var S: TStream);
  192. DESTRUCTOR Done; Virtual;
  193. FUNCTION DataSize: Word; Virtual;
  194. FUNCTION GetPalette: PPalette; Virtual;
  195. FUNCTION Valid (Command: Word): Boolean; Virtual;
  196. PROCEDURE Draw; Virtual;
  197. PROCEDURE DrawCursor; Virtual;
  198. PROCEDURE DrawbackGround; Virtual;
  199. PROCEDURE SelectAll (Enable: Boolean);
  200. PROCEDURE SetValidator (AValid: PValidator);
  201. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  202. PROCEDURE GetData (Var Rec); Virtual;
  203. PROCEDURE SetData (Var Rec); Virtual;
  204. PROCEDURE Store (Var S: TStream);
  205. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  206. PRIVATE
  207. FUNCTION CanScroll (Delta: Integer): Boolean;
  208. END;
  209. PInputLine = ^TInputLine;
  210. {---------------------------------------------------------------------------}
  211. { TButton OBJECT - BUTTON ANCESTOR OBJECT }
  212. {---------------------------------------------------------------------------}
  213. TYPE
  214. TButton = OBJECT (TView)
  215. AmDefault: Boolean; { If default button }
  216. Flags : Byte; { Button flags }
  217. Command : Word; { Button command }
  218. Title : PString; { Button title }
  219. CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ACommand: Word;
  220. AFlags: Word);
  221. CONSTRUCTOR Load (Var S: TStream);
  222. DESTRUCTOR Done; Virtual;
  223. FUNCTION GetPalette: PPalette; Virtual;
  224. PROCEDURE Press; Virtual;
  225. PROCEDURE DrawFocus; Virtual;
  226. PROCEDURE DrawState (Down: Boolean);
  227. PROCEDURE MakeDefault (Enable: Boolean);
  228. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  229. PROCEDURE Store (Var S: TStream);
  230. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  231. PRIVATE
  232. DownFlag: Boolean;
  233. END;
  234. PButton = ^TButton;
  235. {---------------------------------------------------------------------------}
  236. { TCluster OBJECT - CLUSTER ANCESTOR OBJECT }
  237. {---------------------------------------------------------------------------}
  238. TYPE
  239. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  240. TWndArray = Array [0..32000] Of HWnd; { Window handle array }
  241. PWndArray = ^TWndArray; { Ptr to handle array }
  242. {$ENDIF}
  243. TCluster = OBJECT (TView)
  244. Id : Integer; { New communicate id }
  245. Sel : Integer; { Selected item }
  246. Value : LongInt; { Bit value }
  247. EnableMask: LongInt; { Mask enable bits }
  248. Strings : TStringCollection; { String collection }
  249. {$IFNDEF OS_DOS} { WIN/NT/OS2 DATA }
  250. WndHandles: PWndArray; { Window handle array }
  251. {$ENDIF}
  252. CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem);
  253. CONSTRUCTOR Load (Var S: TStream);
  254. DESTRUCTOR Done; Virtual;
  255. FUNCTION DataSize: Word; Virtual;
  256. FUNCTION GetHelpCtx: Word; Virtual;
  257. FUNCTION GetPalette: PPalette; Virtual;
  258. FUNCTION Mark (Item: Integer): Boolean; Virtual;
  259. FUNCTION MultiMark (Item: Integer): Byte; Virtual;
  260. FUNCTION ButtonState (Item: Integer): Boolean;
  261. PROCEDURE DrawFocus; Virtual;
  262. PROCEDURE Press (Item: Integer); Virtual;
  263. PROCEDURE MovedTo (Item: Integer); Virtual;
  264. PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
  265. PROCEDURE DrawMultiBox (Const Icon, Marker: String);
  266. PROCEDURE DrawBox (Const Icon: String; Marker: Char);
  267. PROCEDURE SetButtonState (AMask: Longint; Enable: Boolean);
  268. PROCEDURE GetData (Var Rec); Virtual;
  269. PROCEDURE SetData (Var Rec); Virtual;
  270. PROCEDURE Store (Var S: TStream);
  271. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  272. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  273. FUNCTION GetClassName: String; Virtual;
  274. FUNCTION SubClassAttr: LongInt; Virtual;
  275. FUNCTION GetMsgHandler: Pointer; Virtual;
  276. PROCEDURE CreateWindowNow (CmdShow: Integer); Virtual;
  277. {$ENDIF}
  278. PRIVATE
  279. FUNCTION FindSel (P: TPoint): Integer;
  280. FUNCTION Row (Item: Integer): Integer;
  281. FUNCTION Column (Item: Integer): Integer;
  282. END;
  283. PCluster = ^TCluster;
  284. {---------------------------------------------------------------------------}
  285. { TRadioButtons OBJECT - RADIO BUTTON OBJECT }
  286. {---------------------------------------------------------------------------}
  287. TYPE
  288. TRadioButtons = OBJECT (TCluster)
  289. FUNCTION Mark (Item: Integer): Boolean; Virtual;
  290. PROCEDURE DrawFocus; Virtual;
  291. PROCEDURE Press (Item: Integer); Virtual;
  292. PROCEDURE MovedTo(Item: Integer); Virtual;
  293. PROCEDURE SetData (Var Rec); Virtual;
  294. {$IFNDEF OS_DOS} { WIN/NT CODE }
  295. FUNCTION SubClassAttr: LongInt; Virtual;
  296. {$ENDIF}
  297. END;
  298. PRadioButtons = ^TRadioButtons;
  299. {---------------------------------------------------------------------------}
  300. { TCheckBoxes OBJECT - CHECK BOXES OBJECT }
  301. {---------------------------------------------------------------------------}
  302. TYPE
  303. TCheckBoxes = OBJECT (TCluster)
  304. FUNCTION Mark (Item: Integer): Boolean; Virtual;
  305. PROCEDURE DrawFocus; Virtual;
  306. PROCEDURE Press (Item: Integer); Virtual;
  307. {$IFNDEF OS_DOS} { WIN/NT CODE }
  308. FUNCTION SubClassAttr: LongInt; Virtual;
  309. {$ENDIF}
  310. END;
  311. PCheckBoxes = ^TCheckBoxes;
  312. {---------------------------------------------------------------------------}
  313. { TMultiCheckBoxes OBJECT - CHECK BOXES OBJECT }
  314. {---------------------------------------------------------------------------}
  315. TYPE
  316. TMultiCheckBoxes = OBJECT (TCluster)
  317. SelRange: Byte; { Select item range }
  318. Flags : Word; { Select flags }
  319. States : PString; { Strings }
  320. CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem;
  321. ASelRange: Byte; AFlags: Word; Const AStates: String);
  322. CONSTRUCTOR Load (Var S: TStream);
  323. DESTRUCTOR Done; Virtual;
  324. FUNCTION DataSize: Word; Virtual;
  325. FUNCTION MultiMark (Item: Integer): Byte; Virtual;
  326. PROCEDURE DrawFocus; Virtual;
  327. PROCEDURE Press (Item: Integer); Virtual;
  328. PROCEDURE GetData (Var Rec); Virtual;
  329. PROCEDURE SetData (Var Rec); Virtual;
  330. PROCEDURE Store (Var S: TStream);
  331. {$IFNDEF OS_DOS} { WIN/NT CODE }
  332. FUNCTION SubClassAttr: LongInt; Virtual;
  333. {$ENDIF}
  334. END;
  335. PMultiCheckBoxes = ^TMultiCheckBoxes;
  336. {---------------------------------------------------------------------------}
  337. { TListBox OBJECT - LIST BOX OBJECT }
  338. {---------------------------------------------------------------------------}
  339. TYPE
  340. TListBox = OBJECT (TListViewer)
  341. List: PCollection; { List of strings }
  342. CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Word;
  343. AScrollBar: PScrollBar);
  344. CONSTRUCTOR Load (Var S: TStream);
  345. FUNCTION DataSize: Word; Virtual;
  346. FUNCTION GetText (Item: Integer; MaxLen: Integer): String; Virtual;
  347. PROCEDURE NewList(AList: PCollection); Virtual;
  348. PROCEDURE GetData (Var Rec); Virtual;
  349. PROCEDURE SetData (Var Rec); Virtual;
  350. PROCEDURE Store (Var S: TStream);
  351. END;
  352. PListBox = ^TListBox;
  353. {---------------------------------------------------------------------------}
  354. { TStaticText OBJECT - STATIC TEXT OBJECT }
  355. {---------------------------------------------------------------------------}
  356. TYPE
  357. TStaticText = OBJECT (TView)
  358. Text: PString; { Text string ptr }
  359. CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String);
  360. CONSTRUCTOR Load (Var S: TStream);
  361. DESTRUCTOR Done; Virtual;
  362. FUNCTION GetPalette: PPalette; Virtual;
  363. PROCEDURE DrawBackGround; Virtual;
  364. PROCEDURE Store (Var S: TStream);
  365. PROCEDURE GetText (Var S: String); Virtual;
  366. END;
  367. PStaticText = ^TStaticText;
  368. {---------------------------------------------------------------------------}
  369. { TParamText OBJECT - PARMETER STATIC TEXT OBJECT }
  370. {---------------------------------------------------------------------------}
  371. TYPE
  372. TParamText = OBJECT (TStaticText)
  373. ParamCount: Integer; { Parameter count }
  374. ParamList : Pointer; { Parameter list }
  375. CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String;
  376. AParamCount: Integer);
  377. CONSTRUCTOR Load (Var S: TStream);
  378. FUNCTION DataSize: Word; Virtual;
  379. PROCEDURE GetData (Var Rec); Virtual;
  380. PROCEDURE SetData (Var Rec); Virtual;
  381. PROCEDURE Store (Var S: TStream);
  382. PROCEDURE GetText (Var S: String); Virtual;
  383. END;
  384. PParamText = ^TParamText;
  385. {---------------------------------------------------------------------------}
  386. { TLabel OBJECT - LABEL OBJECT }
  387. {---------------------------------------------------------------------------}
  388. TYPE
  389. TLabel = OBJECT (TStaticText)
  390. Light: Boolean;
  391. Link: PView; { Linked view }
  392. CONSTRUCTOR Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
  393. CONSTRUCTOR Load (Var S: TStream);
  394. FUNCTION GetPalette: PPalette; Virtual;
  395. PROCEDURE DrawBackGround; Virtual;
  396. PROCEDURE Store (Var S: TStream);
  397. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  398. END;
  399. PLabel = ^TLabel;
  400. {---------------------------------------------------------------------------}
  401. { THistoryViewer OBJECT - HISTORY VIEWER OBJECT }
  402. {---------------------------------------------------------------------------}
  403. TYPE
  404. THistoryViewer = OBJECT (TListViewer)
  405. HistoryId: Word; { History id }
  406. CONSTRUCTOR Init(Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  407. AHistoryId: Word);
  408. FUNCTION HistoryWidth: Integer;
  409. FUNCTION GetPalette: PPalette; Virtual;
  410. FUNCTION GetText (Item: Integer; MaxLen: Integer): String; Virtual;
  411. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  412. END;
  413. PHistoryViewer = ^THistoryViewer;
  414. {---------------------------------------------------------------------------}
  415. { THistoryWindow OBJECT - HISTORY WINDOW OBJECT }
  416. {---------------------------------------------------------------------------}
  417. TYPE
  418. THistoryWindow = OBJECT (TWindow)
  419. Viewer: PListViewer; { List viewer object }
  420. CONSTRUCTOR Init (Var Bounds: TRect; HistoryId: Word);
  421. FUNCTION GetSelection: String; Virtual;
  422. FUNCTION GetPalette: PPalette; Virtual;
  423. PROCEDURE InitViewer (HistoryId: Word); Virtual;
  424. END;
  425. PHistoryWindow = ^THistoryWindow;
  426. {---------------------------------------------------------------------------}
  427. { THistory OBJECT - HISTORY OBJECT }
  428. {---------------------------------------------------------------------------}
  429. TYPE
  430. THistory = OBJECT (TView)
  431. HistoryId: Word;
  432. Link: PInputLine;
  433. CONSTRUCTOR Init (Var Bounds: TRect; ALink: PInputLine; AHistoryId: Word);
  434. CONSTRUCTOR Load (Var S: TStream);
  435. FUNCTION GetPalette: PPalette; Virtual;
  436. FUNCTION InitHistoryWindow (Var Bounds: TRect): PHistoryWindow; Virtual;
  437. PROCEDURE Draw; Virtual;
  438. PROCEDURE RecordHistory (CONST S: String); Virtual;
  439. PROCEDURE Store (Var S: TStream);
  440. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  441. END;
  442. PHistory = ^THistory;
  443. {***************************************************************************}
  444. { INTERFACE ROUTINES }
  445. {***************************************************************************}
  446. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  447. { ITEM STRING ROUTINES }
  448. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  449. {-NewSItem-----------------------------------------------------------
  450. Allocates memory for a new TSItem record and sets the text field
  451. and chains to the next TSItem. This allows easy construction of
  452. singly-linked lists of strings, to end a chain the next TSItem
  453. should be nil.
  454. 28Apr98 LdB
  455. ---------------------------------------------------------------------}
  456. FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;
  457. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  458. { DIALOG OBJECT REGISTRATION PROCEDURE }
  459. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  460. {-RegisterDialogs----------------------------------------------------
  461. This registers all the view type objects used in this unit.
  462. 30Sep99 LdB
  463. ---------------------------------------------------------------------}
  464. PROCEDURE RegisterDialogs;
  465. {***************************************************************************}
  466. { STREAM REGISTRATION RECORDS }
  467. {***************************************************************************}
  468. {---------------------------------------------------------------------------}
  469. { TDialog STREAM REGISTRATION }
  470. {---------------------------------------------------------------------------}
  471. CONST
  472. RDialog: TStreamRec = (
  473. ObjType: 10; { Register id = 10 }
  474. {$IFDEF BP_VMTLink} { BP style VMT link }
  475. VmtLink: Ofs(TypeOf(TDialog)^);
  476. {$ELSE} { Alt style VMT link }
  477. VmtLink: TypeOf(TDialog);
  478. {$ENDIF}
  479. Load: @TDialog.Load; { Object load method }
  480. Store: @TDialog.Store { Object store method }
  481. );
  482. {---------------------------------------------------------------------------}
  483. { TInputLine STREAM REGISTRATION }
  484. {---------------------------------------------------------------------------}
  485. CONST
  486. RInputLine: TStreamRec = (
  487. ObjType: 11; { Register id = 11 }
  488. {$IFDEF BP_VMTLink} { BP style VMT link }
  489. VmtLink: Ofs(TypeOf(TInputLine)^);
  490. {$ELSE} { Alt style VMT link }
  491. VmtLink: TypeOf(TInputLine);
  492. {$ENDIF}
  493. Load: @TInputLine.Load; { Object load method }
  494. Store: @TInputLine.Store { Object store method }
  495. );
  496. {---------------------------------------------------------------------------}
  497. { TButton STREAM REGISTRATION }
  498. {---------------------------------------------------------------------------}
  499. CONST
  500. RButton: TStreamRec = (
  501. ObjType: 12; { Register id = 12 }
  502. {$IFDEF BP_VMTLink} { BP style VMT link }
  503. VmtLink: Ofs(TypeOf(TButton)^);
  504. {$ELSE} { Alt style VMT link }
  505. VmtLink: TypeOf(TButton);
  506. {$ENDIF}
  507. Load: @TButton.Load; { Object load method }
  508. Store: @TButton.Store { Object store method }
  509. );
  510. {---------------------------------------------------------------------------}
  511. { TCluster STREAM REGISTRATION }
  512. {---------------------------------------------------------------------------}
  513. CONST
  514. RCluster: TStreamRec = (
  515. ObjType: 13; { Register id = 13 }
  516. {$IFDEF BP_VMTLink} { BP style VMT link }
  517. VmtLink: Ofs(TypeOf(TCluster)^);
  518. {$ELSE} { Alt style VMT link }
  519. VmtLink: TypeOf(TCluster);
  520. {$ENDIF}
  521. Load: @TCluster.Load; { Object load method }
  522. Store: @TCluster.Store { Objects store method }
  523. );
  524. {---------------------------------------------------------------------------}
  525. { TRadioButtons STREAM REGISTRATION }
  526. {---------------------------------------------------------------------------}
  527. CONST
  528. RRadioButtons: TStreamRec = (
  529. ObjType: 14; { Register id = 14 }
  530. {$IFDEF BP_VMTLink} { BP style VMT link }
  531. VmtLink: Ofs(TypeOf(TRadioButtons)^);
  532. {$ELSE} { Alt style VMT link }
  533. VmtLink: TypeOf(TRadioButtons);
  534. {$ENDIF}
  535. Load: @TRadioButtons.Load; { Object load method }
  536. Store: @TRadioButtons.Store { Object store method }
  537. );
  538. {---------------------------------------------------------------------------}
  539. { TCheckBoxes STREAM REGISTRATION }
  540. {---------------------------------------------------------------------------}
  541. CONST
  542. RCheckBoxes: TStreamRec = (
  543. ObjType: 15; { Register id = 15 }
  544. {$IFDEF BP_VMTLink} { BP style VMT link }
  545. VmtLink: Ofs(TypeOf(TCheckBoxes)^);
  546. {$ELSE} { Alt style VMT link }
  547. VmtLink: TypeOf(TCheckBoxes);
  548. {$ENDIF}
  549. Load: @TCheckBoxes.Load; { Object load method }
  550. Store: @TCheckBoxes.Store { Object store method }
  551. );
  552. {---------------------------------------------------------------------------}
  553. { TMultiCheckBoxes STREAM REGISTRATION }
  554. {---------------------------------------------------------------------------}
  555. CONST
  556. RMultiCheckBoxes: TStreamRec = (
  557. ObjType: 27; { Register id = 27 }
  558. {$IFDEF BP_VMTLink} { BP style VMT link }
  559. VmtLink: Ofs(TypeOf(TMultiCheckBoxes)^);
  560. {$ELSE} { Alt style VMT link }
  561. VmtLink: TypeOf(TMultiCheckBoxes);
  562. {$ENDIF}
  563. Load: @TMultiCheckBoxes.Load; { Object load method }
  564. Store: @TMultiCheckBoxes.Store { Object store method }
  565. );
  566. {---------------------------------------------------------------------------}
  567. { TListBox STREAM REGISTRATION }
  568. {---------------------------------------------------------------------------}
  569. CONST
  570. RListBox: TStreamRec = (
  571. ObjType: 16; { Register id = 16 }
  572. {$IFDEF BP_VMTLink} { BP style VMT link }
  573. VmtLink: Ofs(TypeOf(TListBox)^);
  574. {$ELSE} { Alt style VMT link }
  575. VmtLink: TypeOf(TListBox);
  576. {$ENDIF}
  577. Load: @TListBox.Load; { Object load method }
  578. Store: @TListBox.Store { Object store method }
  579. );
  580. {---------------------------------------------------------------------------}
  581. { TStaticText STREAM REGISTRATION }
  582. {---------------------------------------------------------------------------}
  583. CONST
  584. RStaticText: TStreamRec = (
  585. ObjType: 17; { Register id = 17 }
  586. {$IFDEF BP_VMTLink} { BP style VMT link }
  587. VmtLink: Ofs(TypeOf(TStaticText)^);
  588. {$ELSE} { Alt style VMT link }
  589. VmtLink: TypeOf(TStaticText);
  590. {$ENDIF}
  591. Load: @TStaticText.Load; { Object load method }
  592. Store: @TStaticText.Store { Object store method }
  593. );
  594. {---------------------------------------------------------------------------}
  595. { TLabel STREAM REGISTRATION }
  596. {---------------------------------------------------------------------------}
  597. CONST
  598. RLabel: TStreamRec = (
  599. ObjType: 18; { Register id = 18 }
  600. {$IFDEF BP_VMTLink} { BP style VMT link }
  601. VmtLink: Ofs(TypeOf(TLabel)^);
  602. {$ELSE} { Alt style VMT link }
  603. VmtLink: TypeOf(TLabel);
  604. {$ENDIF}
  605. Load: @TLabel.Load; { Object load method }
  606. Store: @TLabel.Store { Object store method }
  607. );
  608. {---------------------------------------------------------------------------}
  609. { THistory STREAM REGISTRATION }
  610. {---------------------------------------------------------------------------}
  611. CONST
  612. RHistory: TStreamRec = (
  613. ObjType: 19; { Register id = 19 }
  614. {$IFDEF BP_VMTLink} { BP style VMT link }
  615. VmtLink: Ofs(TypeOf(THistory)^);
  616. {$ELSE} { Alt style VMT link }
  617. VmtLink: TypeOf(THistory);
  618. {$ENDIF}
  619. Load: @THistory.Load; { Object load method }
  620. Store: @THistory.Store { Object store method }
  621. );
  622. {---------------------------------------------------------------------------}
  623. { TParamText STREAM REGISTRATION }
  624. {---------------------------------------------------------------------------}
  625. CONST
  626. RParamText: TStreamRec = (
  627. ObjType: 20; { Register id = 20 }
  628. {$IFDEF BP_VMTLink} { BP style VMT link }
  629. VmtLink: Ofs(TypeOf(TParamText)^);
  630. {$ELSE} { Alt style VMT link }
  631. VmtLink: TypeOf(TParamText);
  632. {$ENDIF}
  633. Load: @TParamText.Load; { Object load method }
  634. Store: @TParamText.Store { Object store method }
  635. );
  636. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  637. IMPLEMENTATION
  638. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  639. USES HistList; { Standard GFV unit }
  640. {***************************************************************************}
  641. { PRIVATE DEFINED CONSTANTS }
  642. {***************************************************************************}
  643. {---------------------------------------------------------------------------}
  644. { LEFT AND RIGHT ARROW CHARACTER CONSTANTS }
  645. {---------------------------------------------------------------------------}
  646. {$IFDEF OS_DOS} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
  647. {$IFDEF OS_WINDOWS} CONST LeftArr = #$AB; RightArr = #$BB; {$ENDIF}
  648. {$IFDEF OS_OS2} CONST LeftArr = #17; RightArr = #16; {$ENDIF}
  649. {---------------------------------------------------------------------------}
  650. { TButton MESSAGES }
  651. {---------------------------------------------------------------------------}
  652. CONST
  653. cmGrabDefault = 61; { Grab default }
  654. cmReleaseDefault = 62; { Release default }
  655. {***************************************************************************}
  656. { PRIVATE INTERNAL ROUTINES }
  657. {***************************************************************************}
  658. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  659. {---------------------------------------------------------------------------}
  660. { TvClusterMsgHandler -> Platforms WIN/NT - Checked 08Jun98 LdB }
  661. {---------------------------------------------------------------------------}
  662. FUNCTION TvClusterMsgHandler (Wnd: hWnd; iMessage, wParam: sw_Word;
  663. lParam: LongInt): LongInt; {$IFDEF BIT_32} STDCALL; {$ELSE} EXPORT; {$ENDIF}
  664. VAR Sel: Integer; W: sw_Word; P: PCluster;
  665. BEGIN
  666. TvClusterMsgHandler := 0; { Reset return of zero }
  667. Case iMessage Of
  668. WM_KeyDown:; { Ignore keypresses }
  669. WM_Command: Begin
  670. If (wParam AND $FFFF = cmTvClusterButton) { Command message }
  671. Then Begin
  672. {$IFDEF BIT_16} { 16 BIT CODE }
  673. PtrRec(P).Seg := GetProp(Wnd, ViewSeg); { Fetch cluster seg }
  674. PtrRec(P).Ofs := GetProp(Wnd, ViewOfs); { Fetch cluster ofs }
  675. {$ENDIF}
  676. {$IFDEF BIT_32} { 32 BIT CODE }
  677. LongInt(P) := GetProp(Wnd, ViewPtr); { Fetch cluster ptr }
  678. {$ENDIF}
  679. If (P <> Nil) AND (P^.WndHandles <> Nil) { Cluster/handles valid }
  680. Then Begin
  681. If (P^.State AND sfFocused = 0) Then { We have not focus }
  682. P^.FocusFromTop; { Focus up to us }
  683. Sel := 0; { Start on first }
  684. {$IFDEF BIT_16} { 16 BIT CODE }
  685. W := LoWord(lParam); { Use only low part }
  686. {$ENDIF}
  687. {$IFDEF BIT_32} { 32 BIT CODE }
  688. W := lParam; { Use full param }
  689. {$ENDIF}
  690. While (Sel < P^.Strings.Count) AND { Valid item }
  691. (W <> P^.WndHandles^[Sel]) Do Inc(Sel); { Find handle }
  692. If (Sel < P^.Strings.Count) Then Begin { Handle was found }
  693. P^.Press(Sel); { Call press }
  694. P^.Sel := Sel; { Set selection }
  695. If (P^.GetState(sfSelected)=False) { Check not selected }
  696. Then P^.Select Else Begin { Select us then }
  697. P^.SetDrawMask(vdFocus OR vdInner); { Redraw inner }
  698. P^.DrawView; { Redraw partial view }
  699. End;
  700. End;
  701. End;
  702. End Else
  703. TvClusterMsgHandler := TvViewMsgHandler(Wnd,
  704. iMessage, wParam, lParam); { Call TV view handler }
  705. End;
  706. Else TvClusterMsgHandler := TvViewMsgHandler(Wnd,
  707. iMessage, wParam, lParam); { Call TV view handler }
  708. End;
  709. END;
  710. {$ENDIF}
  711. {$IFDEF OS_OS2} { OS2 CODE }
  712. {---------------------------------------------------------------------------}
  713. { TvClusterMsgHandler -> Platforms OS2 - Checked ??Sep99 LdB }
  714. {---------------------------------------------------------------------------}
  715. FUNCTION TvClusterMsgHandler (Wnd: hWnd; iMessage, wParam: sw_Word;
  716. lParam: LongInt): LongInt; STDCALL;
  717. VAR Sel: Integer; W: sw_Word; P: PCluster;
  718. BEGIN
  719. TvClusterMsgHandler := 0; { Reset return of zero }
  720. TvClusterMsgHandler := TvViewMsgHandler(Wnd,
  721. iMessage, wParam, lParam); { Call TV view handler }
  722. END;
  723. {$ENDIF}
  724. {---------------------------------------------------------------------------}
  725. { IsBlank -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
  726. {---------------------------------------------------------------------------}
  727. FUNCTION IsBlank (Ch: Char): Boolean;
  728. BEGIN
  729. IsBlank := (Ch = ' ') OR (Ch = #13) OR (Ch = #10); { Check for characters }
  730. END;
  731. {---------------------------------------------------------------------------}
  732. { HotKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
  733. {---------------------------------------------------------------------------}
  734. FUNCTION HotKey (Const S: String): Char;
  735. VAR I: Word;
  736. BEGIN
  737. HotKey := #0; { Preset fail }
  738. If (S <> '') Then Begin { Valid string }
  739. I := Pos('~', S); { Search for tilde }
  740. If (I <> 0) Then HotKey := UpCase(S[I+1]); { Return hotkey }
  741. End;
  742. END;
  743. {***************************************************************************}
  744. { OBJECT METHODS }
  745. {***************************************************************************}
  746. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  747. { TDialog OBJECT METHODS }
  748. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  749. {--TDialog------------------------------------------------------------------}
  750. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  751. {---------------------------------------------------------------------------}
  752. CONSTRUCTOR TDialog.Init (Var Bounds: TRect; ATitle: TTitleStr);
  753. BEGIN
  754. Inherited Init(Bounds, ATitle, wnNoNumber); { Call ancestor }
  755. Options := Options OR ofVersion20; { Version two dialog }
  756. GrowMode := 0; { Clear grow mode }
  757. Flags := wfMove + wfClose; { Close/moveable flags }
  758. Palette := dpGrayDialog; { Default gray colours }
  759. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  760. GOptions := GOptions AND NOT goThickFramed; { Turn thick frame off }
  761. ExStyle := ws_Ex_DlgModalFrame; { Set extended style }
  762. {$ENDIF}
  763. END;
  764. {--TDialog------------------------------------------------------------------}
  765. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  766. {---------------------------------------------------------------------------}
  767. CONSTRUCTOR TDialog.Load (Var S: TStream);
  768. BEGIN
  769. Inherited Load(S); { Call ancestor }
  770. If (Options AND ofVersion = ofVersion10) Then Begin
  771. Palette := dpGrayDialog; { Set gray palette }
  772. Options := Options OR ofVersion20; { Update version flag }
  773. End;
  774. END;
  775. {--TDialog------------------------------------------------------------------}
  776. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  777. {---------------------------------------------------------------------------}
  778. FUNCTION TDialog.GetPalette: PPalette;
  779. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  780. CONST P: Array[dpBlueDialog..dpGrayDialog] Of String =
  781. (CBlueDialog, CCyanDialog, CGrayDialog); { Possible huge string }
  782. {$ELSE} { OTHER COMPILERS }
  783. CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
  784. (CBlueDialog, CCyanDialog, CGrayDialog); { Always normal string }
  785. {$ENDIF}
  786. BEGIN
  787. GetPalette := @P[Palette]; { Return palette }
  788. END;
  789. {--TDialog------------------------------------------------------------------}
  790. { Valid -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 25Apr98 LdB }
  791. {---------------------------------------------------------------------------}
  792. FUNCTION TDialog.Valid (Command: Word): Boolean;
  793. BEGIN
  794. If (Command = cmCancel) Then Valid := True { Cancel returns true }
  795. Else Valid := TGroup.Valid(Command); { Call group ancestor }
  796. END;
  797. {--TDialog------------------------------------------------------------------}
  798. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  799. {---------------------------------------------------------------------------}
  800. PROCEDURE TDialog.HandleEvent (Var Event: TEvent);
  801. BEGIN
  802. Inherited HandleEvent(Event); { Call ancestor }
  803. Case Event.What Of
  804. evNothing: Exit; { Speed up exit }
  805. evKeyDown: { Key down event }
  806. Case Event.KeyCode Of
  807. kbEsc: Begin { Escape key press }
  808. Event.What := evCommand; { Command event }
  809. Event.Command := cmCancel; { cancel command }
  810. Event.InfoPtr := Nil; { Clear info ptr }
  811. PutEvent(Event); { Put event on queue }
  812. ClearEvent(Event); { Clear the event }
  813. End;
  814. kbEnter: Begin { Enter key press }
  815. Event.What := evBroadcast; { Broadcast event }
  816. Event.Command := cmDefault; { Default command }
  817. Event.InfoPtr := Nil; { Clear info ptr }
  818. PutEvent(Event); { Put event on queue }
  819. ClearEvent(Event); { Clear the event }
  820. End;
  821. End;
  822. evCommand: { Command event }
  823. Case Event.Command Of
  824. cmOk, cmCancel, cmYes, cmNo: { End dialog cmds }
  825. If (State AND sfModal <> 0) Then Begin { View is modal }
  826. EndModal(Event.Command); { End modal state }
  827. ClearEvent(Event); { Clear the event }
  828. End;
  829. End;
  830. End;
  831. END;
  832. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  833. { TInputLine OBJECT METHODS }
  834. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  835. {--TInputLine---------------------------------------------------------------}
  836. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  837. {---------------------------------------------------------------------------}
  838. CONSTRUCTOR TInputLine.Init (Var Bounds: TRect; AMaxLen: Integer);
  839. BEGIN
  840. Inherited Init(Bounds); { Call ancestor }
  841. State := State OR sfCursorVis; { Cursor visible }
  842. Options := Options OR (ofSelectable + ofFirstClick
  843. + ofVersion20); { Set options }
  844. If (MaxAvail > AMaxLen + 1) Then Begin { Check enough memory }
  845. GetMem(Data, AMaxLen + 1); { Allocate memory }
  846. Data^ := ''; { Data = empty string }
  847. End;
  848. MaxLen := AMaxLen; { Hold maximum length }
  849. END;
  850. {--TInputLine---------------------------------------------------------------}
  851. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  852. {---------------------------------------------------------------------------}
  853. CONSTRUCTOR TInputLine.Load (Var S: TStream);
  854. VAR B: Byte;
  855. BEGIN
  856. Inherited Load(S); { Call ancestor }
  857. S.Read(MaxLen, 2); { Read max length }
  858. S.Read(CurPos, 2); { Read cursor position }
  859. S.Read(FirstPos, 2); { Read first position }
  860. S.Read(SelStart, 2); { Read selected start }
  861. S.Read(SelEnd, 2); { Read selected end }
  862. S.Read(B, 1); { Read string length }
  863. If (MaxAvail > MaxLen+1) Then Begin { Check enough memory }
  864. GetMem(Data, MaxLen + 1); { Allocate memory }
  865. S.Read(Data^[1], Length(Data^)); { Read string data }
  866. {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
  867. SetLength(Data^, B); { Xfer string length }
  868. {$ELSE} { OTHER COMPILERS }
  869. Data^[0] := Chr(B); { Set string length }
  870. {$ENDIF}
  871. End Else S.Seek(S.GetPos + B); { Move to position }
  872. If (Options AND ofVersion >= ofVersion20) Then { Version 2 or above }
  873. Validator := PValidator(S.Get); { Get any validator }
  874. Options := Options OR ofVersion20; { Set version 2 flag }
  875. END;
  876. {--TInputLine---------------------------------------------------------------}
  877. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  878. {---------------------------------------------------------------------------}
  879. DESTRUCTOR TInputLine.Done;
  880. BEGIN
  881. If (Data <> Nil) Then FreeMem(Data, MaxLen + 1); { Release any memory }
  882. SetValidator(Nil); { Clear any validator }
  883. Inherited Done; { Call ancestor }
  884. END;
  885. {--TInputLine---------------------------------------------------------------}
  886. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  887. {---------------------------------------------------------------------------}
  888. FUNCTION TInputLine.DataSize: Word;
  889. VAR DSize: Word;
  890. BEGIN
  891. DSize := 0; { Preset zero datasize }
  892. If (Validator <> Nil) AND (Data <> Nil) Then
  893. DSize := Validator^.Transfer(Data^, Nil,
  894. vtDataSize); { Add validator size }
  895. If (DSize <> 0) Then DataSize := DSize { Use validtor size }
  896. Else DataSize := MaxLen + 1; { No validator use size }
  897. END;
  898. {--TInputLine---------------------------------------------------------------}
  899. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  900. {---------------------------------------------------------------------------}
  901. FUNCTION TInputLine.GetPalette: PPalette;
  902. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  903. CONST P: String = CInputLine; { Possible huge string }
  904. {$ELSE} { OTHER COMPILERS }
  905. CONST P: String[Length(CInputLine)] = CInputLine; { Always normal string }
  906. {$ENDIF}
  907. BEGIN
  908. GetPalette := @P; { Return palette }
  909. END;
  910. {--TInputLine---------------------------------------------------------------}
  911. { Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  912. {---------------------------------------------------------------------------}
  913. FUNCTION TInputLine.Valid (Command: Word): Boolean;
  914. FUNCTION AppendError (Validator: PValidator): Boolean;
  915. BEGIN
  916. AppendError := False; { Preset false }
  917. If (Data <> Nil) Then
  918. With Validator^ Do
  919. If (Options AND voOnAppend <> 0) AND { Check options }
  920. (CurPos <> Length(Data^)) AND { Exceeds max length }
  921. NOT IsValidInput(Data^, True) Then Begin { Check data valid }
  922. Error; { Call error }
  923. AppendError := True; { Return true }
  924. End;
  925. END;
  926. BEGIN
  927. Valid := Inherited Valid(Command); { Call ancestor }
  928. If (Validator <> Nil) AND (Data <> Nil) AND { Validator present }
  929. (State AND sfDisabled = 0) Then { Not disabled }
  930. If (Command = cmValid) Then { Valid command }
  931. Valid := Validator^.Status = vsOk { Validator result }
  932. Else If (Command <> cmCancel) Then { Not cancel command }
  933. If AppendError(Validator) OR { Append any error }
  934. NOT Validator^.Valid(Data^) Then Begin { Check validator }
  935. Select; { Reselect view }
  936. Valid := False; { Return false }
  937. End;
  938. END;
  939. {--TInputLine---------------------------------------------------------------}
  940. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  941. {---------------------------------------------------------------------------}
  942. PROCEDURE TInputLine.Draw;
  943. VAR Color: Byte; X, L, R: Integer; S, T: String;
  944. BEGIN
  945. If (State AND sfFocused = 0) Then Color := 1 { Not focused colour }
  946. Else Color := 2; { Focused colour }
  947. If CanScroll(-1) Then WriteStr(0, 0, LeftArr, 4); { Set left scroll mark }
  948. If CanScroll(1) Then WriteStr(-(RawSize.X + 1 -
  949. TextWidth(RightArr)), 0, RightArr, 4); { Set right scroll mark }
  950. If (Data <> Nil) Then S := Copy(Data^, FirstPos+1,
  951. Length(Data^)-FirstPos) Else S := ''; { Fetch data string }
  952. X := TextWidth(LeftArr); { left arrow width }
  953. While (TextWidth(S) > ((RawSize.X+1)-X-TextWidth(
  954. RightArr))) Do Delete(S, Length(S), 1); { Cut to right length }
  955. If (State AND sfFocused <> 0) Then Begin
  956. L := SelStart - FirstPos; { Selected left end }
  957. R := SelEnd - FirstPos; { Selected right end }
  958. If (L < 0) Then L := 0; { Fix any negative }
  959. If (R > Length(S)) Then R := Length(S); { Fix to long case }
  960. If (L > 0) Then Begin
  961. T := Copy(S, 1, L); { Unhighlight bit }
  962. WriteStr(-X, 0, T, Color); { Write string to screen }
  963. X := X + TextWidth(T); { New x position }
  964. Delete(S, 1, L); { Reduce string }
  965. End;
  966. If (L < R) Then Begin
  967. T := Copy(S, 1, R-L); { Highlight bit }
  968. WriteStr(-X, 0, T, 3); { Write string to screen }
  969. X := X + TextWidth(T); { New x position }
  970. Delete(S, 1, R-L); { Reduce string }
  971. End;
  972. If (Length(S) > 0) Then
  973. WriteStr(-X, 0, S, Color); { Write string to screen }
  974. End Else WriteStr(-X, 0, S, Color); { Write string to screen }
  975. Cursor.X := CurPos - FirstPos + 1; { Update cursor position }
  976. END;
  977. {--TInputLine---------------------------------------------------------------}
  978. { DrawbackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  979. {---------------------------------------------------------------------------}
  980. PROCEDURE TInputLine.DrawBackGround;
  981. BEGIN
  982. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  983. If (HWindow <> 0) Then DestroyCaret; { Destroy any caret }
  984. {$ENDIF}
  985. {$IFDEF OS_OS2} { OS2 CODE }
  986. If (HWindow <> 0) Then WinDestroyCursor(HWindow); { Destroy any caret }
  987. {$ENDIF}
  988. Inherited DrawBackGround; { Call ancestor }
  989. END;
  990. {--TInputLine---------------------------------------------------------------}
  991. { DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Oct99 LdB }
  992. {---------------------------------------------------------------------------}
  993. PROCEDURE TInputLine.DrawCursor;
  994. VAR I, X: Integer; S: String;
  995. BEGIN
  996. If (State AND sfFocused <> 0) Then Begin { Focused window }
  997. X := TextWidth(LeftArr); { Preset x position }
  998. I := 0; { Preset cursor width }
  999. If (Data <> Nil) Then Begin { Data pointer valid }
  1000. S := Copy(Data^, FirstPos+1, CurPos-FirstPos); { Copy the string }
  1001. X := X + TextWidth(S); { Calculate position }
  1002. If (State AND sfCursorIns <> 0) Then { Check insert mode }
  1003. If ((CurPos+1) <= Length(Data^)) Then
  1004. I := TextWidth(Data^[CurPos+1]) { Insert caret width }
  1005. Else I := FontWidth; { At end use fontwidth }
  1006. End;
  1007. {$IFDEF OS_DOS}
  1008. If (State AND sfCursorIns <> 0) Then Begin { Insert mode }
  1009. If ((CurPos+1) <= Length(Data^)) Then { Not beyond end }
  1010. WriteStr(-X, 0, Data^[CurPos+1], 5) { Create block cursor }
  1011. Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
  1012. End Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
  1013. {$ENDIF}
  1014. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1015. If (HWindow <> 0) Then Begin
  1016. CreateCaret(HWindow, 0, I, FontHeight); { Create a craet }
  1017. SetCaretPos(X, 0); { Set caret position }
  1018. If (State AND sfCursorVis <> 0) Then
  1019. ShowCaret(HWindow); { Show the caret }
  1020. End;
  1021. {$ENDIF}
  1022. {$IFDEF OS_OS2} { OS2 CODE }
  1023. If (HWindow <> 0) Then Begin
  1024. WinCreateCursor(HWindow, X, 0, 0, FontHeight,
  1025. CURSOR_FLASH, Nil); { Create a craet }
  1026. If (State AND sfCursorVis <> 0) Then
  1027. WinShowCursor(HWindow, True); { Show the caret }
  1028. End;
  1029. {$ENDIF}
  1030. End;
  1031. END;
  1032. {--TInputLine---------------------------------------------------------------}
  1033. { SelectAll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1034. {---------------------------------------------------------------------------}
  1035. PROCEDURE TInputLine.SelectAll (Enable: Boolean);
  1036. BEGIN
  1037. CurPos := 0; { Cursor to start }
  1038. FirstPos := 0; { First pos to start }
  1039. SelStart := 0; { Selected at start }
  1040. If Enable AND (Data <> Nil) Then
  1041. SelEnd := Length(Data^) Else SelEnd := 0; { Selected which end }
  1042. DrawView; { Now redraw the view }
  1043. END;
  1044. {--TInputLine---------------------------------------------------------------}
  1045. { SetValidator -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1046. {---------------------------------------------------------------------------}
  1047. PROCEDURE TInputLine.SetValidator (AValid: PValidator);
  1048. BEGIN
  1049. If (Validator <> Nil) Then Validator^.Free; { Release validator }
  1050. Validator := AValid; { Set new validator }
  1051. END;
  1052. {--TInputLine---------------------------------------------------------------}
  1053. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1054. {---------------------------------------------------------------------------}
  1055. PROCEDURE TInputLine.SetState (AState: Word; Enable: Boolean);
  1056. BEGIN
  1057. Inherited SetState(AState, Enable); { Call ancestor }
  1058. If (AState = sfSelected) OR ((AState = sfActive)
  1059. AND (State and sfSelected <> 0)) Then
  1060. SelectAll(Enable) Else { Call select all }
  1061. If (AState = sfFocused) Then DrawView; { Redraw for focus }
  1062. END;
  1063. {--TInputLine---------------------------------------------------------------}
  1064. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1065. {---------------------------------------------------------------------------}
  1066. PROCEDURE TInputLine.GetData (Var Rec);
  1067. BEGIN
  1068. If (Data <> Nil) Then Begin { Data ptr valid }
  1069. If (Validator = Nil) OR (Validator^.Transfer(Data^,
  1070. @Rec, vtGetData) = 0) Then Begin { No validator/data }
  1071. FillChar(Rec, DataSize, #0); { Clear the data area }
  1072. Move(Data^, Rec, Length(Data^) + 1); { Transfer our data }
  1073. End;
  1074. End Else FillChar(Rec, DataSize, #0); { Clear the data area }
  1075. END;
  1076. {--TInputLine---------------------------------------------------------------}
  1077. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1078. {---------------------------------------------------------------------------}
  1079. PROCEDURE TInputLine.SetData (Var Rec);
  1080. {$IFDEF PPC_DELPHI3} VAR Buf: Array [0..256] Of Char; {$ENDIF}
  1081. BEGIN
  1082. If (Data <> Nil) Then Begin { Data ptr valid }
  1083. If (Validator = Nil) OR (Validator^.Transfer(
  1084. Data^, @Rec, vtSetData) = 0) Then { No validator/data }
  1085. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  1086. Move(Rec, Buf, DataSize); { Fetch our data }
  1087. Move(Buf[1], Data^[1], Ord(Buf[0])); { Tranfer string }
  1088. SetLength(Data^, Ord(Buf[0])); { Set string length }
  1089. {$ELSE} { OTHER COMPILERS }
  1090. Move(Rec, Data^[0], DataSize); { Set our data }
  1091. {$ENDIF}
  1092. End;
  1093. SelectAll(True); { Now select all }
  1094. END;
  1095. {--TInputLine---------------------------------------------------------------}
  1096. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1097. {---------------------------------------------------------------------------}
  1098. PROCEDURE TInputLine.Store (Var S: TStream);
  1099. BEGIN
  1100. TView.Store(S); { Implict TView.Store }
  1101. S.Write(MaxLen, 2); { Read max length }
  1102. S.Write(CurPos, 2); { Read cursor position }
  1103. S.Write(FirstPos, 2); { Read first position }
  1104. S.Write(SelStart, 2); { Read selected start }
  1105. S.Write(SelEnd, 2); { Read selected end }
  1106. S.WriteStr(Data); { Write the data }
  1107. S.Put(Validator); { Write any validator }
  1108. END;
  1109. {--TInputLine---------------------------------------------------------------}
  1110. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1111. {---------------------------------------------------------------------------}
  1112. PROCEDURE TInputLine.HandleEvent (Var Event: TEvent);
  1113. CONST PadKeys = [$47, $4B, $4D, $4F, $73, $74];
  1114. VAR WasAppending: Boolean; ExtendBlock: Boolean; OldData: String;
  1115. Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Integer;
  1116. FUNCTION MouseDelta: Integer;
  1117. BEGIN
  1118. If (Event.Where.X <= RawOrigin.X+TextWidth(LeftArr))
  1119. Then MouseDelta := -1 Else { To left of text area }
  1120. If ((Event.Where.X-RawOrigin.X) >= RawSize.X -
  1121. TextWidth(RightArr)) Then MouseDelta := 1 { To right of text area }
  1122. Else MouseDelta := 0; { In area return 0 }
  1123. END;
  1124. FUNCTION MousePos: Integer;
  1125. VAR Mp, Tw, Pos: Integer; S: String;
  1126. BEGIN
  1127. Mp := Event.Where.X - RawOrigin.X; { Mouse position }
  1128. If (Data <> Nil) Then S := Copy(Data^, FirstPos+1,
  1129. Length(Data^)-FirstPos) Else S := ''; { Text area string }
  1130. Tw := TextWidth(LeftArr); { Text width }
  1131. Pos := 0; { Zero position }
  1132. While (Mp > Tw) AND (Pos <= Length(S)) Do Begin { Still text to right }
  1133. Tw := Tw + TextWidth(S[Pos+1]); { Add next character }
  1134. Inc(Pos); { Next character }
  1135. End;
  1136. If (Pos > 0) Then Dec(Pos);
  1137. MousePos := FirstPos + Pos; { Return mouse position }
  1138. END;
  1139. PROCEDURE DeleteSelect;
  1140. BEGIN
  1141. If (SelStart <> SelEnd) Then Begin { An area selected }
  1142. If (Data <> Nil) Then
  1143. Delete(Data^, SelStart+1, SelEnd-SelStart); { Delete the text }
  1144. CurPos := SelStart; { Set cursor position }
  1145. End;
  1146. END;
  1147. PROCEDURE AdjustSelectBlock;
  1148. BEGIN
  1149. If (CurPos < Anchor) Then Begin { Selection backwards }
  1150. SelStart := CurPos; { Start of select }
  1151. SelEnd := Anchor; { End of select }
  1152. End Else Begin
  1153. SelStart := Anchor; { Start of select }
  1154. SelEnd := CurPos; { End of select }
  1155. End;
  1156. END;
  1157. PROCEDURE SaveState;
  1158. BEGIN
  1159. If (Validator <> Nil) Then Begin { Check for validator }
  1160. If (Data <> Nil) Then OldData := Data^; { Hold data }
  1161. OldCurPos := CurPos; { Hold cursor position }
  1162. OldFirstPos := FirstPos; { Hold first position }
  1163. OldSelStart := SelStart; { Hold select start }
  1164. OldSelEnd := SelEnd; { Hold select end }
  1165. If (Data = Nil) Then WasAppending := True { Invalid data ptr }
  1166. Else WasAppending := Length(Data^) = CurPos; { Hold appending state }
  1167. End;
  1168. END;
  1169. PROCEDURE RestoreState;
  1170. BEGIN
  1171. If (Validator <> Nil) Then Begin { Validator valid }
  1172. If (Data <> Nil) Then Data^ := OldData; { Restore data }
  1173. CurPos := OldCurPos; { Restore cursor pos }
  1174. FirstPos := OldFirstPos; { Restore first pos }
  1175. SelStart := OldSelStart; { Restore select start }
  1176. SelEnd := OldSelEnd; { Restore select end }
  1177. End;
  1178. END;
  1179. FUNCTION CheckValid (NoAutoFill: Boolean): Boolean;
  1180. VAR OldLen: Integer; NewData: String;
  1181. BEGIN
  1182. If (Validator <> Nil) Then Begin { Validator valid }
  1183. CheckValid := False; { Preset false return }
  1184. If (Data <> Nil) Then OldLen := Length(Data^); { Hold old length }
  1185. If (Validator^.Options AND voOnAppend = 0) OR
  1186. (WasAppending AND (CurPos = OldLen)) Then Begin
  1187. If (Data <> Nil) Then NewData := Data^ { Hold current data }
  1188. Else NewData := ''; { Set empty string }
  1189. If NOT Validator^.IsValidInput(NewData,
  1190. NoAutoFill) Then RestoreState Else Begin
  1191. If (Length(NewData) > MaxLen) Then { Exceeds maximum }
  1192. {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
  1193. SetLength(NewData, MaxLen); { Set string length }
  1194. {$ELSE} { OTHER COMPILERS }
  1195. NewData[0] := Chr(MaxLen); { Set string length }
  1196. {$ENDIF}
  1197. If (Data <> Nil) Then Data^ := NewData; { Set data value }
  1198. If (Data <> Nil) AND (CurPos >= OldLen) { Cursor beyond end }
  1199. AND (Length(Data^) > OldLen) Then { Cursor beyond string }
  1200. CurPos := Length(Data^); { Set cursor position }
  1201. CheckValid := True; { Return true result }
  1202. End;
  1203. End Else Begin
  1204. CheckValid := True; { Preset true return }
  1205. If (CurPos = OldLen) AND (Data <> Nil) Then { Lengths match }
  1206. If NOT Validator^.IsValidInput(Data^,
  1207. False) Then Begin { Check validator }
  1208. Validator^.Error; { Call error }
  1209. CheckValid := False; { Return false result }
  1210. End;
  1211. End;
  1212. End Else CheckValid := True; { No validator }
  1213. END;
  1214. BEGIN
  1215. Inherited HandleEvent(Event); { Call ancestor }
  1216. If (State AND sfSelected <> 0) Then Begin { View is selected }
  1217. Case Event.What Of
  1218. evNothing: Exit; { Speed up exit }
  1219. evMouseDown: Begin { Mouse down event }
  1220. Delta := MouseDelta; { Calc scroll value }
  1221. If CanScroll(Delta) Then Begin { Can scroll }
  1222. Repeat
  1223. If CanScroll(Delta) Then Begin { Still can scroll }
  1224. Inc(FirstPos, Delta); { Move start position }
  1225. DrawView; { Redraw the view }
  1226. End;
  1227. Until NOT MouseEvent(Event, evMouseAuto); { Until no mouse auto }
  1228. End Else If Event.Double Then { Double click }
  1229. SelectAll(True) Else Begin { Select whole text }
  1230. Anchor := MousePos; { Start of selection }
  1231. Repeat
  1232. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1233. If (Event.What = evMouseAuto) { Mouse auto event }
  1234. {$ELSE} { WIN/NT/OS2 CODE }
  1235. If (Event.What = evMouseMove) { Mouse move event }
  1236. {$ENDIF}
  1237. Then Begin
  1238. Delta := MouseDelta; { New position }
  1239. If CanScroll(Delta) Then { If can scroll }
  1240. Inc(FirstPos, Delta);
  1241. End;
  1242. CurPos := MousePos; { Set cursor position }
  1243. AdjustSelectBlock; { Adjust selected }
  1244. DrawView; { Redraw the view }
  1245. Until NOT MouseEvent(Event, evMouseMove
  1246. + evMouseAuto); { Until mouse released }
  1247. End;
  1248. ClearEvent(Event); { Clear the event }
  1249. End;
  1250. evKeyDown: Begin
  1251. SaveState; { Save state of view }
  1252. Event.KeyCode := CtrlToArrow(Event.KeyCode); { Convert keycode }
  1253. If (Event.ScanCode IN PadKeys) AND
  1254. (GetShiftState AND $03 <> 0) Then Begin { Mark selection active }
  1255. Event.CharCode := #0; { Clear char code }
  1256. If (CurPos = SelEnd) Then { Find if at end }
  1257. Anchor := SelStart Else { Anchor from start }
  1258. Anchor := SelEnd; { Anchor from end }
  1259. ExtendBlock := True; { Extended block true }
  1260. End Else ExtendBlock := False; { No extended block }
  1261. Case Event.KeyCode Of
  1262. kbLeft: If (CurPos > 0) Then Dec(CurPos); { Move cursor left }
  1263. kbRight: If (Data <> Nil) AND { Move right cursor }
  1264. (CurPos < Length(Data^)) Then Begin { Check not at end }
  1265. Inc(CurPos); { Move cursor }
  1266. CheckValid(True); { Check if valid }
  1267. End;
  1268. kbHome: CurPos := 0; { Move to line start }
  1269. kbEnd: Begin { Move to line end }
  1270. If (Data = Nil) Then CurPos := 0 { Invalid data ptr }
  1271. Else CurPos := Length(Data^); { Set cursor position }
  1272. CheckValid(True); { Check if valid }
  1273. End;
  1274. kbBack: If (Data <> Nil) AND (CurPos > 0) { Not at line start }
  1275. Then Begin
  1276. Delete(Data^, CurPos, 1); { Backspace over char }
  1277. Dec(CurPos); { Move cursor back one }
  1278. If (FirstPos > 0) Then Dec(FirstPos); { Move first position }
  1279. CheckValid(True); { Check if valid }
  1280. End;
  1281. kbDel: If (Data <> Nil) Then Begin { Delete character }
  1282. If (SelStart = SelEnd) Then { Select all on }
  1283. If (CurPos < Length(Data^)) Then Begin { Cursor not at end }
  1284. SelStart := CurPos; { Set select start }
  1285. SelEnd := CurPos + 1; { Set select end }
  1286. End;
  1287. DeleteSelect; { Deselect selection }
  1288. CheckValid(True); { Check if valid }
  1289. End;
  1290. kbIns: SetState(sfCursorIns, State AND
  1291. sfCursorIns = 0); { Flip insert state }
  1292. Else Case Event.CharCode Of
  1293. ' '..#255: If (Data <> Nil) Then Begin { Character key }
  1294. If (State AND sfCursorIns <> 0) Then
  1295. Delete(Data^, CurPos + 1, 1) Else { Overwrite character }
  1296. DeleteSelect; { Deselect selected }
  1297. If CheckValid(True) Then Begin { Check data valid }
  1298. If (Length(Data^) < MaxLen) Then { Must not exceed maxlen }
  1299. Begin
  1300. If (FirstPos > CurPos) Then
  1301. FirstPos := CurPos; { Advance first position }
  1302. Inc(CurPos); { Increment cursor }
  1303. Insert(Event.CharCode, Data^,
  1304. CurPos); { Insert the character }
  1305. End;
  1306. CheckValid(False); { Check data valid }
  1307. End;
  1308. End;
  1309. ^Y: If (Data <> Nil) Then Begin { Clear all data }
  1310. Data^ := ''; { Set empty string }
  1311. CurPos := 0; { Cursor to start }
  1312. End;
  1313. Else Exit; { Unused key }
  1314. End
  1315. End;
  1316. If ExtendBlock Then AdjustSelectBlock { Extended block }
  1317. Else Begin
  1318. SelStart := CurPos; { Set select start }
  1319. SelEnd := CurPos; { Set select end }
  1320. End;
  1321. If (FirstPos > CurPos) Then
  1322. FirstPos := CurPos; { Advance first pos }
  1323. If (Data <> Nil) Then OldData := Copy(Data^,
  1324. FirstPos+1, CurPos-FirstPos) { Text area string }
  1325. Else OldData := ''; { Empty string }
  1326. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1327. Delta := FontWidth; { Safety = 1 char }
  1328. {$ELSE} { WIN/NT CODE }
  1329. Delta := 2*FontWidth; { Safety = 2 char }
  1330. {$ENDIF}
  1331. While (TextWidth(OldData) > ((RawSize.X+1)-Delta)
  1332. - TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits }
  1333. Do Begin
  1334. Inc(FirstPos); { Advance first pos }
  1335. OldData := Copy(Data^, FirstPos+1,
  1336. CurPos-FirstPos) { Text area string }
  1337. End;
  1338. DrawView; { Redraw the view }
  1339. ClearEvent(Event); { Clear the event }
  1340. End;
  1341. End;
  1342. End;
  1343. END;
  1344. {***************************************************************************}
  1345. { TInputLine OBJECT PRIVATE METHODS }
  1346. {***************************************************************************}
  1347. {--TInputLine---------------------------------------------------------------}
  1348. { CanScroll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1349. {---------------------------------------------------------------------------}
  1350. FUNCTION TInputLine.CanScroll (Delta: Integer): Boolean;
  1351. VAR S: String;
  1352. BEGIN
  1353. If (Delta < 0) Then CanScroll := FirstPos > 0 { Check scroll left }
  1354. Else If (Delta > 0) Then Begin
  1355. If (Data = Nil) Then S := '' Else { Data ptr invalid }
  1356. S := Copy(Data^, FirstPos+1, Length(Data^)
  1357. - FirstPos); { Fetch max string }
  1358. CanScroll := (TextWidth(S)) > (RawSize.X -
  1359. TextWidth(LeftArr) - TextWidth(RightArr)); { Check scroll right }
  1360. End Else CanScroll := False; { Zero so no scroll }
  1361. END;
  1362. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1363. { TButton OBJECT METHODS }
  1364. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1365. {--TButton------------------------------------------------------------------}
  1366. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1367. {---------------------------------------------------------------------------}
  1368. CONSTRUCTOR TButton.Init (Var Bounds: TRect; ATitle: TTitleStr;
  1369. ACommand: Word; AFlags: Word);
  1370. BEGIN
  1371. Inherited Init(Bounds); { Call ancestor }
  1372. EventMask := EventMask OR evBroadcast; { Handle broadcasts }
  1373. GOptions := GOptions OR goDrawFocus; { Set new option mask }
  1374. Options := Options OR (ofSelectable + ofFirstClick
  1375. + ofPreProcess + ofPostProcess); { Set option flags }
  1376. If NOT CommandEnabled(ACommand) Then
  1377. State := State OR sfDisabled; { Check command state }
  1378. Flags := AFlags; { Hold flags }
  1379. If (AFlags AND bfDefault <> 0) Then AmDefault := True
  1380. Else AmDefault := False; { Check if default }
  1381. Title := NewStr(ATitle); { Hold title string }
  1382. Command := ACommand; { Hold button command }
  1383. TabMask := TabMask OR (tmLeft + tmRight +
  1384. tmTab + tmShiftTab + tmUp + tmDown); { Set tab masks }
  1385. END;
  1386. {--TButton------------------------------------------------------------------}
  1387. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1388. {---------------------------------------------------------------------------}
  1389. CONSTRUCTOR TButton.Load (Var S: TStream);
  1390. BEGIN
  1391. Inherited Load(S); { Call ancestor }
  1392. Title := S.ReadStr; { Read title }
  1393. S.Read(Command, 2); { Read command }
  1394. S.Read(Flags, 1); { Read flags }
  1395. S.Read(AmDefault, 1); { Read if default }
  1396. If NOT CommandEnabled(Command) Then { Check command state }
  1397. State := State OR sfDisabled Else { Command disabled }
  1398. State := State AND NOT sfDisabled; { Command enabled }
  1399. END;
  1400. {--TButton------------------------------------------------------------------}
  1401. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1402. {---------------------------------------------------------------------------}
  1403. DESTRUCTOR TButton.Done;
  1404. BEGIN
  1405. If (Title <> Nil) Then DisposeStr(Title); { Dispose title }
  1406. Inherited Done; { Call ancestor }
  1407. END;
  1408. {--TButton------------------------------------------------------------------}
  1409. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
  1410. {---------------------------------------------------------------------------}
  1411. FUNCTION TButton.GetPalette: PPalette;
  1412. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  1413. CONST P: String = CButton; { Possible huge string }
  1414. {$ELSE} { OTHER COMPILERS }
  1415. CONST P: String[Length(CButton)] = CButton; { Always normal string }
  1416. {$ENDIF}
  1417. BEGIN
  1418. GetPalette := @P; { Get button palette }
  1419. END;
  1420. {--TButton------------------------------------------------------------------}
  1421. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Apr98 LdB }
  1422. {---------------------------------------------------------------------------}
  1423. PROCEDURE TButton.Press;
  1424. VAR E: TEvent;
  1425. BEGIN
  1426. Message(Owner, evBroadcast, cmRecordHistory, Nil); { Message for history }
  1427. If (Flags AND bfBroadcast <> 0) Then { Broadcasting button }
  1428. Message(Owner, evBroadcast, Command, @Self) { Send message }
  1429. Else Begin
  1430. E.What := evCommand; { Command event }
  1431. E.Command := Command; { Set command value }
  1432. E.InfoPtr := @Self; { Pointer to self }
  1433. PutEvent(E); { Put event on queue }
  1434. End;
  1435. END;
  1436. {--TButton------------------------------------------------------------------}
  1437. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1438. {---------------------------------------------------------------------------}
  1439. PROCEDURE TButton.DrawFocus;
  1440. VAR B: Byte; I: Integer; Bc: Word; Db: TDrawBuffer;
  1441. BEGIN
  1442. If DownFlag Then B := 7 Else B := 0; { Shadow colour }
  1443. GraphRectangle(0, 0, RawSize.X, RawSize.Y, B); { Draw backing shadow }
  1444. GraphRectangle(1, 1, RawSize.X-1, RawSize.Y-1, B); { Draw backing shadow }
  1445. If DownFlag Then B := 0 Else B := 15; { Highlight colour }
  1446. GraphLine(0, RawSize.Y, 0, 0, B);
  1447. GraphLine(1, RawSize.Y-1, 1, 1, B); { Left highlights }
  1448. GraphLine(0, 0, RawSize.X, 0, B);
  1449. GraphLine(1, 1, RawSize.X-1, 1, B); { Top highlights }
  1450. If DownFlag Then B := 8 Else B := 7; { Select backing }
  1451. If (State AND sfFocused <> 0) AND
  1452. (DownFlag = False) Then B := 14; { Show as focused }
  1453. GraphRectangle(2, 2, RawSize.X-2, RawSize.Y-2, B); { Draw first border }
  1454. GraphRectangle(3, 3, RawSize.X-3, RawSize.Y-3, B); { Draw next border }
  1455. If (State AND sfDisabled <> 0) Then { Button disabled }
  1456. Bc := GetColor($0404) Else Begin { Disabled colour }
  1457. Bc := GetColor($0501); { Set normal colour }
  1458. If (State AND sfActive <> 0) Then { Button is active }
  1459. If (State AND sfSelected <> 0) Then
  1460. Bc := GetColor($0703) Else { Set selected colour }
  1461. If AmDefault Then Bc := GetColor($0602); { Set is default colour }
  1462. End;
  1463. If (Title <> Nil) Then Begin { We have a title }
  1464. If (Flags AND bfLeftJust = 0) Then Begin { Not left set title }
  1465. I := TextWidth(Title^); { Fetch title width }
  1466. I := (RawSize.X - I) DIV 2; { Centre in button }
  1467. End Else I := FontWidth; { Left edge of button }
  1468. MoveCStr(Db, Title^, Bc); { Move title to buffer }
  1469. GOptions := GOptions OR goGraphView; { Graphics co-ords mode }
  1470. WriteLine(I, FontHeight DIV 2, CStrLen(Title^),
  1471. 1, Db); { Write the title }
  1472. GOptions := GOptions AND NOT goGraphView; { Return to normal mode }
  1473. End;
  1474. END;
  1475. {--TButton------------------------------------------------------------------}
  1476. { DrawState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1477. {---------------------------------------------------------------------------}
  1478. PROCEDURE TButton.DrawState (Down: Boolean);
  1479. BEGIN
  1480. DownFlag := Down; { Set down flag }
  1481. SetDrawMask(vdFocus); { Set focus mask }
  1482. DrawView; { Redraw the view }
  1483. END;
  1484. {--TButton------------------------------------------------------------------}
  1485. { MakeDefault -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1486. {---------------------------------------------------------------------------}
  1487. PROCEDURE TButton.MakeDefault (Enable: Boolean);
  1488. VAR C: Word;
  1489. BEGIN
  1490. If (Flags AND bfDefault=0) Then Begin { Not default }
  1491. If Enable Then C := cmGrabDefault
  1492. Else C := cmReleaseDefault; { Change default }
  1493. Message(Owner, evBroadcast, C, @Self); { Message to owner }
  1494. AmDefault := Enable; { Set default flag }
  1495. DrawView; { Now redraw button }
  1496. End;
  1497. END;
  1498. {--TButton------------------------------------------------------------------}
  1499. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
  1500. {---------------------------------------------------------------------------}
  1501. PROCEDURE TButton.SetState (AState: Word; Enable: Boolean);
  1502. BEGIN
  1503. Inherited SetState(AState, Enable); { Call ancestor }
  1504. If (AState AND (sfSelected + sfActive) <> 0) { Changing select }
  1505. Then DrawView; { Redraw required }
  1506. If (AState AND sfFocused <> 0) Then
  1507. MakeDefault(Enable); { Check for default }
  1508. END;
  1509. {--TButton------------------------------------------------------------------}
  1510. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  1511. {---------------------------------------------------------------------------}
  1512. PROCEDURE TButton.Store (Var S: TStream);
  1513. BEGIN
  1514. TView.Store(S); { Implict TView.Store }
  1515. S.WriteStr(Title); { Store title string }
  1516. S.Write(Command, 2); { Store command }
  1517. S.Write(Flags, 1); { Store flags }
  1518. S.Write(AmDefault, 1); { Store default flag }
  1519. END;
  1520. {--TButton------------------------------------------------------------------}
  1521. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
  1522. {---------------------------------------------------------------------------}
  1523. PROCEDURE TButton.HandleEvent (Var Event: TEvent);
  1524. VAR Down: Boolean; C: Char; ButRect: TRect;
  1525. BEGIN
  1526. ButRect.A := RawOrigin; { Get origin point }
  1527. ButRect.B.X := RawOrigin.X + RawSize.X; { Calc right side }
  1528. ButRect.B.Y := RawOrigin.Y + RawSize.Y; { Calc bottom }
  1529. If (Event.What = evMouseDown) Then Begin { Mouse down event }
  1530. If NOT MouseInView(Event.Where) Then Begin { If point not in view }
  1531. ClearEvent(Event); { Clear the event }
  1532. Exit; { Speed up exit }
  1533. End;
  1534. End;
  1535. If (Flags AND bfGrabFocus <> 0) Then { Check focus grab }
  1536. Inherited HandleEvent(Event); { Call ancestor }
  1537. Case Event.What Of
  1538. evNothing: Exit; { Speed up exit }
  1539. evMouseDown: Begin
  1540. If (State AND sfDisabled = 0) Then Begin { Button not disabled }
  1541. Down := False; { Clear down flag }
  1542. Repeat
  1543. If (Down <> ButRect.Contains(Event.Where)) { State has changed }
  1544. Then Begin
  1545. Down := NOT Down; { Invert down flag }
  1546. DrawState(Down); { Redraw button }
  1547. End;
  1548. Until NOT MouseEvent(Event, evMouseMove); { Wait for mouse move }
  1549. If Down Then Begin { Button is down }
  1550. Press; { Send out command }
  1551. DrawState(False); { Draw button up }
  1552. End;
  1553. End;
  1554. ClearEvent(Event); { Event was handled }
  1555. End;
  1556. evKeyDown: Begin
  1557. If (Title <> Nil) Then C := HotKey(Title^) { Key title hotkey }
  1558. Else C := #0; { Invalid title }
  1559. If (Event.KeyCode = GetAltCode(C)) OR { Alt char }
  1560. (Owner^.Phase = phPostProcess) AND (C <> #0)
  1561. AND (Upcase(Event.CharCode) = C) OR { Matches hotkey }
  1562. (State AND sfFocused <> 0) AND { View focused }
  1563. ((Event.CharCode = ' ') OR { Space bar }
  1564. (Event.KeyCode=kbEnter)) Then Begin { Enter key }
  1565. DrawState(True); { Draw button down }
  1566. Press; { Send out command }
  1567. ClearEvent(Event); { Clear the event }
  1568. DrawState(False); { Draw button up }
  1569. End;
  1570. End;
  1571. evBroadcast:
  1572. Case Event.Command of
  1573. cmDefault: If AmDefault AND { Default command }
  1574. (State AND sfDisabled = 0) Then Begin { Button enabled }
  1575. Press; { Send out command }
  1576. ClearEvent(Event); { Clear the event }
  1577. End;
  1578. cmGrabDefault, cmReleaseDefault: { Grab and release cmd }
  1579. If (Flags AND bfDefault <> 0) Then Begin { Change button state }
  1580. AmDefault := Event.Command = cmReleaseDefault;
  1581. DrawView; { Redraw the view }
  1582. End;
  1583. cmCommandSetChanged: Begin { Command set changed }
  1584. SetState(sfDisabled, NOT
  1585. CommandEnabled(Command)); { Set button state }
  1586. DrawView; { Redraw the view }
  1587. End;
  1588. End;
  1589. End;
  1590. END;
  1591. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1592. { TCluster OBJECT METHODS }
  1593. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  1594. CONST TvClusterClassName = 'TVCLUSTER';
  1595. {--TCluster-----------------------------------------------------------------}
  1596. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
  1597. {---------------------------------------------------------------------------}
  1598. CONSTRUCTOR TCluster.Init (Var Bounds: TRect; AStrings: PSItem);
  1599. VAR I: Integer; P: PSItem;
  1600. BEGIN
  1601. Inherited Init(Bounds); { Call ancestor }
  1602. GOptions := GOptions OR goDrawFocus; { Draw focus view }
  1603. Options := Options OR (ofSelectable + ofFirstClick
  1604. + ofPreProcess + ofPostProcess + ofVersion20); { Set option masks }
  1605. I := 0; { Zero string count }
  1606. P := AStrings; { First item }
  1607. While (P <> Nil) Do Begin
  1608. Inc(I); { Count 1 item }
  1609. P := P^.Next; { Move to next item }
  1610. End;
  1611. Strings.Init(I, 0); { Create collection }
  1612. While (AStrings <> Nil) Do Begin
  1613. P := AStrings; { Transfer item ptr }
  1614. Strings.AtInsert(Strings.Count, AStrings^.Value);{ Insert string }
  1615. AStrings := AStrings^.Next; { Move to next item }
  1616. Dispose(P); { Dispose prior item }
  1617. End;
  1618. EnableMask := $FFFFFFFF; { Enable bit masks }
  1619. END;
  1620. {--TCluster-----------------------------------------------------------------}
  1621. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Oct99 LdB }
  1622. {---------------------------------------------------------------------------}
  1623. CONSTRUCTOR TCluster.Load (Var S: TStream);
  1624. BEGIN
  1625. Inherited Load(S); { Call ancestor }
  1626. S.Read(Value, 4); { Read value }
  1627. S.Read(Sel, 2); { Read select item }
  1628. If ((Options AND ofVersion) >= ofVersion20) { Version 2 TV view }
  1629. Then S.Read(EnableMask, 4) Else Begin { Read enable masks }
  1630. EnableMask := $FFFFFFFF; { Enable all masks }
  1631. Options := Options OR ofVersion20; { Set version 2 mask }
  1632. End;
  1633. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  1634. S.Read(Id, 2); { Read view id }
  1635. Strings.Load(S); { Load string data }
  1636. SetButtonState(0, True); { Set button state }
  1637. END;
  1638. {--TCluster-----------------------------------------------------------------}
  1639. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
  1640. {---------------------------------------------------------------------------}
  1641. DESTRUCTOR TCluster.Done;
  1642. VAR I: Integer;
  1643. BEGIN
  1644. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  1645. If (WndHandles <> Nil) Then Begin { Handles valid }
  1646. For I := 1 To Strings.Count Do { For each entry }
  1647. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1648. DestroyWindow(WndHandles^[I-1]); { Destroy button views }
  1649. {$ELSE} { OS2 CODE }
  1650. WinDestroyWindow(WndHandles^[I-1]); { Destroy button views }
  1651. {$ENDIF}
  1652. FreeMem(WndHandles, Strings.Count*SizeOf(HWnd)); { Release memory }
  1653. End;
  1654. {$ENDIF}
  1655. Strings.Done; { Dispose of strings }
  1656. Inherited Done; { Call ancestor }
  1657. END;
  1658. {--TCluster-----------------------------------------------------------------}
  1659. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1660. {---------------------------------------------------------------------------}
  1661. FUNCTION TCluster.DataSize: Word;
  1662. BEGIN
  1663. DataSize := SizeOf(Word); { Exchanges a word }
  1664. END;
  1665. {--TCluster-----------------------------------------------------------------}
  1666. { GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1667. {---------------------------------------------------------------------------}
  1668. FUNCTION TCluster.GetHelpCtx: Word;
  1669. BEGIN
  1670. If (HelpCtx = hcNoContext) Then { View has no help }
  1671. GetHelpCtx := hcNoContext Else { No help context }
  1672. GetHelpCtx := HelpCtx + Sel; { Help of selected }
  1673. END;
  1674. {--TCluster-----------------------------------------------------------------}
  1675. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  1676. {---------------------------------------------------------------------------}
  1677. FUNCTION TCluster.GetPalette: PPalette;
  1678. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  1679. CONST P: String = CCluster; { Possible huge string }
  1680. {$ELSE} { OTHER COMPILERS }
  1681. CONST P: String[Length(CCluster)] = CCluster; { Always normal string }
  1682. {$ENDIF}
  1683. BEGIN
  1684. GetPalette := @P; { Cluster palette }
  1685. END;
  1686. {--TCluster-----------------------------------------------------------------}
  1687. { Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  1688. {---------------------------------------------------------------------------}
  1689. FUNCTION TCluster.Mark (Item: Integer): Boolean;
  1690. BEGIN
  1691. Mark := False; { Default false }
  1692. END;
  1693. {--TCluster-----------------------------------------------------------------}
  1694. { MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  1695. {---------------------------------------------------------------------------}
  1696. FUNCTION TCluster.MultiMark (Item: Integer): Byte;
  1697. BEGIN
  1698. MultiMark := Byte(Mark(Item) = True); { Return multi mark }
  1699. END;
  1700. {--TCluster-----------------------------------------------------------------}
  1701. { ButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  1702. {---------------------------------------------------------------------------}
  1703. FUNCTION TCluster.ButtonState (Item: Integer): Boolean;
  1704. BEGIN
  1705. If (Item > 31) Then ButtonState := False Else { Impossible item }
  1706. ButtonState := ((1 SHL Item) AND EnableMask)<>0; { Return true/false }
  1707. END;
  1708. {--TCluster-----------------------------------------------------------------}
  1709. { DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Jul99 LdB }
  1710. {---------------------------------------------------------------------------}
  1711. PROCEDURE TCluster.DrawFocus;
  1712. BEGIN
  1713. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  1714. If (WndHandles <> Nil) Then { Valid window handles }
  1715. If (State AND sfFocused <> 0) Then Begin { View is focused }
  1716. If (Sel >= 0) AND (Sel < Strings.Count) Then
  1717. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1718. SetFocus(WndHandles^[Sel]) { Focus selected view }
  1719. Else SetFocus(AppWindow); { Focus owner }
  1720. {$ELSE} { OS2 CODE }
  1721. WinSetFocus(HWND_DESKTOP, WndHandles^[Sel]) { Focus selected view }
  1722. Else WinSetFocus(HWND_DESKTOP, HWindow); { Focus owner }
  1723. {$ENDIF}
  1724. End Else
  1725. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1726. SetFocus(AppWindow); { Focus owner }
  1727. {$ELSE} { OS2 CODE }
  1728. WinSetFocus(HWND_DESKTOP, AppWindow); { Focus owner }
  1729. {$ENDIF}
  1730. {$ENDIF}
  1731. END;
  1732. {--TCluster-----------------------------------------------------------------}
  1733. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  1734. {---------------------------------------------------------------------------}
  1735. PROCEDURE TCluster.Press (Item: Integer);
  1736. VAR P: PView;
  1737. BEGIN
  1738. P := TopView;
  1739. If (Id <> 0) AND (P <> Nil) Then NewMessage(P,
  1740. evCommand, cmIdCommunicate, Id, Value, @Self); { Send new message }
  1741. END;
  1742. {--TCluster-----------------------------------------------------------------}
  1743. { MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  1744. {---------------------------------------------------------------------------}
  1745. PROCEDURE TCluster.MovedTo (Item: Integer);
  1746. BEGIN { Abstract method }
  1747. END;
  1748. {--TCluster-----------------------------------------------------------------}
  1749. { SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  1750. {---------------------------------------------------------------------------}
  1751. PROCEDURE TCluster.SetState (AState: Word; Enable: Boolean);
  1752. BEGIN
  1753. Inherited SetState(AState, Enable); { Call ancestor }
  1754. If (AState AND sfFocused <> 0) Then Begin
  1755. SetDrawMask(vdFocus OR vdInner); { Set redraw masks }
  1756. DrawView; { Redraw masked areas }
  1757. End;
  1758. END;
  1759. {--TCluster-----------------------------------------------------------------}
  1760. { DrawMultiBox -> Platforms DOS/DPMI/WIN/NT - Updated 05Jun98 LdB }
  1761. {---------------------------------------------------------------------------}
  1762. PROCEDURE TCluster.DrawMultiBox (Const Icon, Marker: String);
  1763. VAR I, J, K, Cur, Col: Integer; CNorm, CSel, CDis, Color: Word; B: TDrawBuffer;
  1764. Tb, SCOff: Byte;
  1765. {$IFNDEF OS_DOS} S: String; P: PString; Q: PChar; {$ENDIF}
  1766. BEGIN
  1767. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  1768. CNorm := GetColor($0301); { Normal colour }
  1769. CSel := GetColor($0402); { Selected colour }
  1770. CDis := GetColor($0505); { Disabled colour }
  1771. If (Options AND ofFramed <>0) OR { Normal frame }
  1772. (GOptions AND goThickFramed <>0) Then { Thick frame }
  1773. K := 1 Else K := 0; { Select offset }
  1774. For I := 0 To Size.Y-K-K-1 Do Begin { For each line }
  1775. MoveChar(B, ' ', Byte(CNorm), Size.X-K-K); { Fill buffer }
  1776. For J := 0 To (Strings.Count - 1) DIV Size.Y + 1
  1777. Do Begin
  1778. Cur := J*Size.Y + I; { Current line }
  1779. If (Cur < Strings.Count) Then Begin
  1780. Col := Column(Cur); { Calc column }
  1781. If (Col + CStrLen(PString(Strings.At(Cur))^)+
  1782. 5 < Sizeof(TDrawBuffer) DIV SizeOf(Word))
  1783. AND (Col < Size.X-K-K) Then Begin { Text fits in column }
  1784. If NOT ButtonState(Cur) Then
  1785. Color := CDis Else If (Cur = Sel) AND { Disabled colour }
  1786. (State and sfFocused <> 0) Then
  1787. Color := CSel Else { Selected colour }
  1788. Color := CNorm; { Normal colour }
  1789. MoveChar(B[Col], ' ', Byte(Color),
  1790. Size.X-K-K-Col); { Set this colour }
  1791. MoveStr(B[Col], Icon, Byte(Color)); { Transfer icon string }
  1792. WordRec(B[Col+2]).Lo := Byte(Marker[
  1793. MultiMark(Cur) + 1]); { Transfer marker }
  1794. MoveCStr(B[Col+5], PString(Strings.At(
  1795. Cur))^, Color); { Transfer item string }
  1796. If ShowMarkers AND (State AND sfFocused <> 0)
  1797. AND (Cur = Sel) Then Begin { Current is selected }
  1798. WordRec(B[Col]).Lo := Byte(SpecialChars[0]);
  1799. WordRec(B[Column(Cur+Size.Y)-1]).Lo
  1800. := Byte(SpecialChars[1]); { Set special character }
  1801. End;
  1802. End;
  1803. End;
  1804. End;
  1805. WriteBuf(K, K+I, Size.X-K-K, 1, B); { Write buffer }
  1806. End;
  1807. {$ELSE} { WIN/NT/OS2 CODE }
  1808. If (WndHandles <> Nil) Then Begin { Valid window handles }
  1809. For I := 1 To Strings.Count Do Begin { For each window }
  1810. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1811. Tb := GetWindowText(WndHandles^[I-1], @S[1],
  1812. 255); { Get window text }
  1813. {$ELSE} { OS2 CODE }
  1814. Tb := WinQueryWindowText(WndHandles^[I-1], 255,
  1815. @S[1]); { Get window text }
  1816. {$ENDIF}
  1817. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  1818. SetLength(S, Tb); { Set string length }
  1819. {$ELSE} { OTHER COMPILERS }
  1820. S[0] := Chr(Tb); { Set string length }
  1821. {$ENDIF}
  1822. P := Strings.At(I-1); { Cluster strings }
  1823. If (P <> Nil) AND (P^ <> S) Then Begin { Something changed }
  1824. S := P^ + #0; { Transfer string }
  1825. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1826. SetWindowText(WndHandles^[I-1], @S[1]); { Set new window text }
  1827. {$ELSE} { OS2 CODE }
  1828. WinSetWindowText(WndHandles^[I-1], @S[1]); { Set new window text }
  1829. {$ENDIF}
  1830. End;
  1831. If Mark(I-1) Then { If item marked }
  1832. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  1833. SendMessage(WndHandles^[I-1], bm_SetCheck,
  1834. 1, 0) Else { Check the box }
  1835. SendMessage(WndHandles^[I-1], bm_SetCheck,
  1836. 0, 0); { Uncheck the box }
  1837. {$ELSE} { OS2 CODE }
  1838. WinSendMsg(WndHandles^[I-1], bm_SetCheck,
  1839. 1, 0) Else { Check the box }
  1840. WinSendMsg(WndHandles^[I-1], bm_SetCheck,
  1841. 0, 0); { Uncheck the box }
  1842. {$ENDIF}
  1843. End;
  1844. End;
  1845. {$ENDIF}
  1846. END;
  1847. {--TCluster-----------------------------------------------------------------}
  1848. { DrawBox -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  1849. {---------------------------------------------------------------------------}
  1850. PROCEDURE TCluster.DrawBox (Const Icon: String; Marker: Char);
  1851. BEGIN
  1852. DrawMultiBox(Icon, ' '+Marker); { Call draw routine }
  1853. END;
  1854. {--TCluster-----------------------------------------------------------------}
  1855. { SetButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  1856. {---------------------------------------------------------------------------}
  1857. PROCEDURE TCluster.SetButtonState (AMask: Longint; Enable: Boolean);
  1858. VAR I: Integer; M: Longint;
  1859. BEGIN
  1860. If Enable Then EnableMask := EnableMask OR AMask { Set enable bit mask }
  1861. Else EnableMask := EnableMask AND NOT AMask; { Disable bit mask }
  1862. If (Strings.Count <= 32) Then Begin { Valid string number }
  1863. M := 1; { Preset bit masks }
  1864. For I := 1 To Strings.Count Do Begin { For each item string }
  1865. If ((M AND EnableMask) <> 0) Then Begin { Bit enabled }
  1866. Options := Options OR ofSelectable; { Set selectable option }
  1867. Exit; { Now exit }
  1868. End;
  1869. M := M SHL 1; { Create newbit mask }
  1870. End;
  1871. Options := Options AND NOT ofSelectable; { Make not selectable }
  1872. End;
  1873. END;
  1874. {--TCluster-----------------------------------------------------------------}
  1875. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  1876. {---------------------------------------------------------------------------}
  1877. PROCEDURE TCluster.GetData (Var Rec);
  1878. BEGIN
  1879. Word(Rec) := Value; { Return current value }
  1880. END;
  1881. {--TCluster-----------------------------------------------------------------}
  1882. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  1883. {---------------------------------------------------------------------------}
  1884. PROCEDURE TCluster.SetData (Var Rec);
  1885. BEGIN
  1886. Value := Word(Rec); { Set current value }
  1887. SetDrawMask(vdFocus OR vdInner); { Set redraw mask }
  1888. DrawView; { Redraw masked areas }
  1889. END;
  1890. {--TCluster-----------------------------------------------------------------}
  1891. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  1892. {---------------------------------------------------------------------------}
  1893. PROCEDURE TCluster.Store (Var S: TStream);
  1894. BEGIN
  1895. TView.Store(S); { TView.Store called }
  1896. If ((Options AND ofVersion) >= ofVersion20) { Version 2 TV view }
  1897. Then Begin
  1898. S.Write(Value, SizeOf(LongInt)); { Write value }
  1899. S.Write(Sel, SizeOf(Sel)); { Write select item }
  1900. S.Write(EnableMask, SizeOf(EnableMask)); { Write enable masks }
  1901. End Else Begin
  1902. S.Write(Value, SizeOf(Word)); { Write value }
  1903. S.Write(Sel, SizeOf(Sel)); { Write select item }
  1904. End;
  1905. If (Options AND ofGFVModeView <> 0) Then { GFV mode view check }
  1906. S.Write(Id, SizeOf(Id)); { Write new id value }
  1907. Strings.Store(S); { Store strings }
  1908. END;
  1909. {--TCluster-----------------------------------------------------------------}
  1910. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Jun98 LdB }
  1911. {---------------------------------------------------------------------------}
  1912. PROCEDURE TCluster.HandleEvent (Var Event: TEvent);
  1913. VAR C: Char; I, J, S, Vh: Integer; Key: Word; Mouse: TPoint; Ts: PString;
  1914. PROCEDURE MoveSel;
  1915. BEGIN
  1916. If (I <= Strings.Count) Then Begin
  1917. Sel := S; { Set selected item }
  1918. MovedTo(Sel); { Move to selected }
  1919. SetDrawMask(vdInner OR vdFocus); { Set draw masks }
  1920. DrawView; { Now draw changes }
  1921. End;
  1922. END;
  1923. BEGIN
  1924. Inherited HandleEvent(Event); { Call ancestor }
  1925. If ((Options AND ofSelectable) = 0) Then Exit; { Check selectable }
  1926. If (Event.What = evMouseDown) Then Begin { MOUSE EVENT }
  1927. MakeLocal(Event.Where, Mouse); { Make point local }
  1928. I := FindSel(Mouse); { Find selected item }
  1929. If (I <> -1) Then { Check in view }
  1930. If ButtonState(I) Then Sel := I; { If enabled select }
  1931. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  1932. DrawView; { Now draw changes }
  1933. Repeat
  1934. MakeLocal(Event.Where, Mouse); { Make point local }
  1935. Until NOT MouseEvent(Event, evMouseMove); { Wait for mouse up }
  1936. MakeLocal(Event.Where, Mouse); { Make point local }
  1937. If (FindSel(Mouse) = Sel) AND ButtonState(Sel) { If valid/selected }
  1938. Then Begin
  1939. Press(Sel); { Call pressed }
  1940. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  1941. DrawView; { Now draw changes }
  1942. End;
  1943. ClearEvent(Event); { Event was handled }
  1944. End Else If (Event.What = evKeyDown) Then Begin { KEY EVENT }
  1945. If (Options AND ofFramed <> 0) OR { Normal frame }
  1946. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  1947. J := 1 Else J := 0; { Adjust value }
  1948. Vh := Size.Y - J - J; { View height }
  1949. S := Sel; { Hold current item }
  1950. Key := CtrlToArrow(Event.KeyCode); { Convert keystroke }
  1951. Case Key Of
  1952. kbUp, kbDown, kbRight, kbLeft:
  1953. If (State AND sfFocused <> 0) Then Begin { Focused key event }
  1954. I := 0; { Zero process count }
  1955. Repeat
  1956. Inc(I); { Inc process count }
  1957. Case Key Of
  1958. kbUp: Dec(S); { Next item up }
  1959. kbDown: Inc(S); { Next item down }
  1960. kbRight: Begin { Next column across }
  1961. Inc(S, Vh); { Move to next column }
  1962. If (S >= Strings.Count) Then { No next column check }
  1963. S := (S+1) MOD Vh; { Move to last column }
  1964. End;
  1965. kbLeft: Begin { Prior column across }
  1966. Dec(S, Vh); { Move to prior column }
  1967. If (S < 0) Then S := ((Strings.Count +
  1968. Vh - 1) DIV Vh) * Vh + S - 1; { No prior column check }
  1969. End;
  1970. End;
  1971. If (S >= Strings.Count) Then S := 0; { Roll up to top }
  1972. If (S < 0) Then S := Strings.Count - 1; { Roll down to bottom }
  1973. Until ButtonState(S) OR (I > Strings.Count); { Repeat until select }
  1974. MoveSel; { Move to selected }
  1975. ClearEvent(Event); { Event was handled }
  1976. End;
  1977. Else Begin { Not an arrow key }
  1978. For I := 0 To Strings.Count-1 Do Begin { Scan each item }
  1979. Ts := Strings.At(I); { Fetch string pointer }
  1980. If (Ts <> Nil) Then C := HotKey(Ts^) { Check for hotkey }
  1981. Else C := #0; { No valid string }
  1982. If (GetAltCode(C) = Event.KeyCode) OR { Hot key for item }
  1983. (((Owner^.Phase = phPostProcess) OR { Owner in post process }
  1984. (State AND sfFocused <> 0)) AND (C <> #0) { Non zero hotkey }
  1985. AND (UpCase(Event.CharCode) = C)) { Matches current key }
  1986. Then Begin
  1987. If ButtonState(I) Then Begin { Check mask enabled }
  1988. If Focus Then Begin { Check view focus }
  1989. Sel := I; { Set selected }
  1990. MovedTo(Sel); { Move to selected }
  1991. Press(Sel); { Call pressed }
  1992. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  1993. DrawView; { Now draw changes }
  1994. End;
  1995. ClearEvent(Event); { Event was handled }
  1996. End;
  1997. Exit; { Now exit }
  1998. End;
  1999. End;
  2000. {$IFDEF OS_DOS} { DOS/DPMI CODE }
  2001. If (Event.CharCode = ' ') AND { Spacebar key }
  2002. (State AND sfFocused <> 0) AND { Check focused view }
  2003. ButtonState(Sel) Then Begin { Check item enabled }
  2004. Press(Sel); { Call pressed }
  2005. SetDrawMask(vdFocus OR vdInner); { Set draw mask }
  2006. DrawView; { Now draw changes }
  2007. ClearEvent(Event); { Event was handled }
  2008. End;
  2009. {$ENDIF}
  2010. End;
  2011. End;
  2012. End;
  2013. END;
  2014. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  2015. {***************************************************************************}
  2016. { TCLuster OBJECT WIN/NT/OS2 ONLY METHODS }
  2017. {***************************************************************************}
  2018. {--TCluster-----------------------------------------------------------------}
  2019. { GetClassName -> Platforms WIN/NT/OS2 - Updated 03Jun98 LdB }
  2020. {---------------------------------------------------------------------------}
  2021. FUNCTION TCluster.GetClassName: String;
  2022. BEGIN
  2023. GetClassName := TvClusterClassName; { Cluster class name }
  2024. END;
  2025. {--TCluster-----------------------------------------------------------------}
  2026. { SubClassAttr -> Platforms WIN/NT/OS2 - Updated 02Jun98 LdB }
  2027. {---------------------------------------------------------------------------}
  2028. FUNCTION TCluster.SubClassAttr: LongInt;
  2029. VAR Li: LongInt;
  2030. BEGIN
  2031. If (State AND sfVisible = 0) Then Li := 0 { View not visible }
  2032. Else Li := ws_Visible; { View is visible }
  2033. If (State AND sfDisabled <> 0) Then { Check disabled flag }
  2034. Li := Li OR ws_Disabled; { Set disabled flag }
  2035. Li := Li OR ws_ClipChildren OR ws_ClipSiblings; { Must have these }
  2036. SubClassAttr := Li; { Return attributes }
  2037. END;
  2038. {--TCluster-----------------------------------------------------------------}
  2039. { GetMsgHandler -> Platforms WIN/NT/OS2 - Updated 02Jun98 LdB }
  2040. {---------------------------------------------------------------------------}
  2041. FUNCTION TCluster.GetMsgHandler: Pointer;
  2042. BEGIN
  2043. GetMsgHandler := @TvClusterMsgHandler; { Cluster msg handler }
  2044. END;
  2045. {--TCluster-----------------------------------------------------------------}
  2046. { CreateWindowNow -> Platforms WIN/NT - Updated 28May98 LdB }
  2047. {---------------------------------------------------------------------------}
  2048. PROCEDURE TCluster.CreateWindowNow (CmdShow: Integer);
  2049. VAR I, J, L: Integer; Li: LongInt; Ct: String; Ts: PString; P: PChar; Wnd: HWnd;
  2050. BEGIN
  2051. If (HWindow = 0) Then Begin { Window not created }
  2052. Inherited CreateWindowNow (CmdShow); { Call ancestor }
  2053. If (HWindow <> 0) Then Begin { Window now created }
  2054. GetMem(WndHandles, Strings.Count*SizeOf(HWnd));{ Allocate memory }
  2055. For I := 1 To Strings.Count Do Begin
  2056. L := (I-1) * FontHeight; { Height of each line }
  2057. Ts := Strings.At(I-1); { Fetch string pointer }
  2058. If (Ts <> Nil) Then Ct := Ts^ Else Ct := ''; { Get string text }
  2059. Ct := Ct + #0; { Make asciiz }
  2060. J := Pos('~', Ct); { Check for tilde }
  2061. If (J <> 0) Then Ct[J] := '&'; { Sub 1st tilde }
  2062. Repeat
  2063. J := Pos('~', Ct); { Check for tilde }
  2064. If (J <> 0) Then System.Delete(Ct, J, 1); { Remove the tilde }
  2065. Until (J = 0); { Remove all tildes }
  2066. If (Ct <> #0) Then Begin { Check for empty }
  2067. GetMem(P, Length(Ct)); { Allocate memory }
  2068. Move(Ct[1], P^, Length(Ct)); { Move string data }
  2069. End Else P := Nil; { Return nil ptr }
  2070. {$IFDEF OS_WINDOWS}
  2071. If (Options AND ofFramed <> 0) OR { Normal frame }
  2072. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2073. Wnd := CreateWindowEx(0, 'BUTTON', P,
  2074. SubClassAttr OR ws_Child OR ws_Visible, FontWidth,
  2075. L+FontHeight, RawSize.X-2*FontWidth+1,
  2076. FontHeight, HWindow, cmTvClusterButton,
  2077. HInstance, Nil) Else { Create window }
  2078. Wnd := CreateWindowEx(0, 'BUTTON', P,
  2079. SubClassAttr OR ws_Child OR ws_Visible, 0, L,
  2080. RawSize.X+1, FontHeight, HWindow,
  2081. cmTvClusterButton, HInstance, Nil); { Create window }
  2082. If (Wnd <> 0) Then Begin { Window created ok }
  2083. {$IFDEF PPC_FPC}
  2084. Windows.SendMessage(Wnd, WM_SetFont,
  2085. DefGFVFont, 1); { Set font style }
  2086. {$ELSE}
  2087. WinProcs.SendMessage(Wnd, WM_SetFont,
  2088. DefGFVFont, 1); { Set font style }
  2089. {$ENDIF}
  2090. Li := LongInt(@Self); { Address of self }
  2091. {$IFDEF BIT_16} { 16 BIT CODE }
  2092. SetProp(Wnd, ViewSeg,
  2093. Li AND $FFFF0000 SHR 16); { Set seg property }
  2094. SetProp(Wnd, ViewOfs,
  2095. Li AND $0000FFFF); { Set ofs propertry }
  2096. {$ENDIF}
  2097. {$IFDEF BIT_32} { 32 BIT CODE }
  2098. SetProp(Wnd, ViewPtr, Li); { Set view property }
  2099. {$ENDIF}
  2100. If (CmdShow <> 0) Then
  2101. ShowWindow(Wnd, cmdShow); { Execute show cmd }
  2102. UpdateWindow(Wnd); { Update the window }
  2103. BringWindowToTop(Wnd); { Bring window to top }
  2104. End;
  2105. WndHandles^[I-1] := Wnd; { Hold the handle }
  2106. If Mark(I-1) Then { If item marked }
  2107. SendMessage(WndHandles^[I-1], bm_SetCheck,
  2108. 1, 0) Else { Check the item }
  2109. SendMessage(WndHandles^[I-1], bm_SetCheck,
  2110. 0, 0); { Uncheck the item }
  2111. {$ENDIF}
  2112. End;
  2113. End;
  2114. End;
  2115. END;
  2116. {$ENDIF}
  2117. {***************************************************************************}
  2118. { TCluster OBJECT PRIVATE METHODS }
  2119. {***************************************************************************}
  2120. {--TCluster-----------------------------------------------------------------}
  2121. { FindSel -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2122. {---------------------------------------------------------------------------}
  2123. FUNCTION TCluster.FindSel (P: TPoint): Integer;
  2124. VAR I, J, S, Vh: Integer; R: TRect;
  2125. BEGIN
  2126. GetExtent(R); { Get view extents }
  2127. If R.Contains(P) Then Begin { Point in view }
  2128. If (Options AND ofFramed <> 0) OR { Normal frame }
  2129. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2130. J := 1 Else J := 0; { Adjust value }
  2131. Vh := Size.Y - J - J; { View height }
  2132. I := 0; { Preset zero value }
  2133. While (P.X >= Column(I+Vh)) Do Inc(I, Vh); { Inc view size }
  2134. S := I + P.Y - J; { Line to select }
  2135. If ((S >= 0) AND (S < Strings.Count)) { Valid selection }
  2136. Then FindSel := S Else FindSel := -1; { Return selected item }
  2137. End Else FindSel := -1; { Point outside view }
  2138. END;
  2139. {--TCluster-----------------------------------------------------------------}
  2140. { Row -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2141. {---------------------------------------------------------------------------}
  2142. FUNCTION TCluster.Row (Item: Integer): Integer;
  2143. BEGIN
  2144. If (Options AND ofFramed <> 0) OR { Normal frame }
  2145. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2146. Row := Item MOD (Size.Y - 2) Else { Allow for frames }
  2147. Row := Item MOD Size.Y; { Normal mod value }
  2148. END;
  2149. {--TCluster-----------------------------------------------------------------}
  2150. { Column -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
  2151. {---------------------------------------------------------------------------}
  2152. FUNCTION TCluster.Column (Item: Integer): Integer;
  2153. VAR I, J, Col, Width, L, Vh: Integer; Ts: PString;
  2154. BEGIN
  2155. If (Options AND ofFramed <> 0) OR { Normal frame }
  2156. (GOptions AND goThickFramed <> 0) Then { Thick frame }
  2157. J := 1 Else J := 0; { Adjust value }
  2158. Vh := Size.Y - J - J; { Vertical size }
  2159. If (Item >= Vh) Then Begin { Valid selection }
  2160. Width := 0; { Zero width }
  2161. Col := -6; { Start column at -6 }
  2162. For I := 0 To Item Do Begin { For each item }
  2163. If (I MOD Vh = 0) Then Begin { Start next column }
  2164. Inc(Col, Width + 6); { Add column width }
  2165. Width := 0; { Zero width }
  2166. End;
  2167. If (I < Strings.Count) Then Begin { Valid string }
  2168. Ts := Strings.At(I); { Transfer string }
  2169. If (Ts <> Nil) Then L := CStrLen(Ts^) { Length of string }
  2170. Else L := 0; { No string }
  2171. End;
  2172. If (L > Width) Then Width := L; { Hold longest string }
  2173. End;
  2174. Column := Col; { Return column }
  2175. End Else Column := 0; { Outside select area }
  2176. END;
  2177. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2178. { TRadioButtons OBJECT METHODS }
  2179. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2180. {--TRadioButtons------------------------------------------------------------}
  2181. { Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2182. {---------------------------------------------------------------------------}
  2183. FUNCTION TRadioButtons.Mark (Item: Integer): Boolean;
  2184. BEGIN
  2185. Mark := Item = Value; { True if item = value }
  2186. END;
  2187. {--TRadioButtons------------------------------------------------------------}
  2188. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2189. {---------------------------------------------------------------------------}
  2190. PROCEDURE TRadioButtons.DrawFocus;
  2191. CONST Button = ' ( ) ';
  2192. BEGIN
  2193. Inherited DrawFocus;
  2194. DrawMultiBox(Button, #32#7); { Redraw the text }
  2195. END;
  2196. {--TRadioButtons------------------------------------------------------------}
  2197. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2198. {---------------------------------------------------------------------------}
  2199. PROCEDURE TRadioButtons.Press (Item: Integer);
  2200. BEGIN
  2201. Value := Item; { Set value field }
  2202. Inherited Press(Item); { Call ancestor }
  2203. END;
  2204. {--TRadioButtons------------------------------------------------------------}
  2205. { MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2206. {---------------------------------------------------------------------------}
  2207. PROCEDURE TRadioButtons.MovedTo (Item: Integer);
  2208. BEGIN
  2209. Value := Item; { Set value to item }
  2210. If (Id <> 0) Then NewMessage(Owner, evCommand,
  2211. cmIdCommunicate, Id, Value, @Self); { Send new message }
  2212. END;
  2213. {--TRadioButtons------------------------------------------------------------}
  2214. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2215. {---------------------------------------------------------------------------}
  2216. PROCEDURE TRadioButtons.SetData (Var Rec);
  2217. BEGIN
  2218. Sel := Integer(Rec); { Set selection }
  2219. Inherited SetData(Rec); { Call ancestor }
  2220. END;
  2221. {$IFNDEF OS_DOS} { WIN/NT CODE }
  2222. {***************************************************************************}
  2223. { TRadioButtons OBJECT WIN/NT/OS2 ONLY METHODS }
  2224. {***************************************************************************}
  2225. {--TRadioButtons------------------------------------------------------------}
  2226. { SubClassAttr -> Platforms WIN/NT/OS2 - Updated 20May98 LdB }
  2227. {---------------------------------------------------------------------------}
  2228. FUNCTION TRadioButtons.SubClassAttr: LongInt;
  2229. BEGIN
  2230. SubClassAttr := Inherited SubClassAttr OR
  2231. bs_RadioButton; { Radio button }
  2232. END;
  2233. {$ENDIF}
  2234. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2235. { TCheckBoxes OBJECT METHODS }
  2236. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2237. {--TCheckBoxes--------------------------------------------------------------}
  2238. { Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2239. {---------------------------------------------------------------------------}
  2240. FUNCTION TCheckBoxes.Mark(Item: Integer): Boolean;
  2241. BEGIN
  2242. If (Value AND (1 SHL Item) <> 0) Then { Check if item ticked }
  2243. Mark := True Else Mark := False; { Return result }
  2244. END;
  2245. {--TCheckBoxes--------------------------------------------------------------}
  2246. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
  2247. {---------------------------------------------------------------------------}
  2248. PROCEDURE TCheckBoxes.DrawFocus;
  2249. CONST Button = ' [ ] ';
  2250. BEGIN
  2251. Inherited DrawFocus;
  2252. DrawMultiBox(Button, ' X'); { Redraw the text }
  2253. END;
  2254. {--TCheckBoxes--------------------------------------------------------------}
  2255. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
  2256. {---------------------------------------------------------------------------}
  2257. PROCEDURE TCheckBoxes.Press (Item: Integer);
  2258. BEGIN
  2259. Value := Value XOR (1 SHL Item); { Flip the item mask }
  2260. Inherited Press(Item); { Call ancestor }
  2261. END;
  2262. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  2263. {***************************************************************************}
  2264. { TCheckBoxes OBJECT WIN/NT/OS2 ONLY METHODS }
  2265. {***************************************************************************}
  2266. {--TCheckBoxes--------------------------------------------------------------}
  2267. { SubClassAttr -> Platforms WIN/NT/OS2 - Updated 20May98 LdB }
  2268. {---------------------------------------------------------------------------}
  2269. FUNCTION TCheckBoxes.SubClassAttr: LongInt;
  2270. BEGIN
  2271. SubClassAttr := Inherited SubClassAttr OR
  2272. bs_CheckBox; { Check box buttons }
  2273. END;
  2274. {$ENDIF}
  2275. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2276. { TMultiCheckBoxes OBJECT METHODS }
  2277. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2278. {--TMultiCheckBoxes---------------------------------------------------------}
  2279. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Jun98 LdB }
  2280. {---------------------------------------------------------------------------}
  2281. CONSTRUCTOR TMultiCheckBoxes.Init (Var Bounds: TRect; AStrings: PSItem;
  2282. ASelRange: Byte; AFlags: Word; Const AStates: String);
  2283. BEGIN
  2284. Inherited Init(Bounds, AStrings); { Call ancestor }
  2285. SelRange := ASelRange; { Hold select range }
  2286. Flags := AFlags; { Hold flags }
  2287. States := NewStr(AStates); { Hold string }
  2288. END;
  2289. {--TMultiCheckBoxes---------------------------------------------------------}
  2290. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2291. {---------------------------------------------------------------------------}
  2292. CONSTRUCTOR TMultiCheckBoxes.Load (Var S: TStream);
  2293. BEGIN
  2294. Inherited Load(S); { Call ancestor }
  2295. S.Read(SelRange, SizeOf(SelRange)); { Read select range }
  2296. S.Read(Flags, SizeOf(Flags)); { Read flags }
  2297. States := S.ReadStr; { Read strings }
  2298. END;
  2299. {--TMultiCheckBoxes---------------------------------------------------------}
  2300. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2301. {---------------------------------------------------------------------------}
  2302. DESTRUCTOR TMultiCheckBoxes.Done;
  2303. BEGIN
  2304. If (States <> Nil) Then DisposeStr(States); { Dispose strings }
  2305. Inherited Done; { Call ancestor }
  2306. END;
  2307. {--TMultiCheckBoxes---------------------------------------------------------}
  2308. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2309. {---------------------------------------------------------------------------}
  2310. FUNCTION TMultiCheckBoxes.DataSize: Word;
  2311. BEGIN
  2312. DataSize := SizeOf(LongInt); { Size to exchange }
  2313. END;
  2314. {--TMultiCheckBoxes---------------------------------------------------------}
  2315. { MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2316. {---------------------------------------------------------------------------}
  2317. FUNCTION TMultiCheckBoxes.MultiMark (Item: Integer): Byte;
  2318. BEGIN
  2319. MultiMark := (Value SHR (Word(Item) *
  2320. WordRec(Flags).Hi)) AND WordRec(Flags).Lo; { Return mark state }
  2321. END;
  2322. {--TMultiCheckBoxes---------------------------------------------------------}
  2323. { Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2324. {---------------------------------------------------------------------------}
  2325. PROCEDURE TMultiCheckBoxes.DrawFocus;
  2326. CONST Button = ' [ ] ';
  2327. BEGIN
  2328. Inherited DrawFocus;
  2329. DrawMultiBox(Button, States^); { Draw the items }
  2330. END;
  2331. {--TMultiCheckBoxes---------------------------------------------------------}
  2332. { Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2333. {---------------------------------------------------------------------------}
  2334. PROCEDURE TMultiCheckBoxes.Press (Item: Integer);
  2335. VAR CurState: ShortInt;
  2336. BEGIN
  2337. CurState := (Value SHR (Word(Item) *
  2338. WordRec(Flags).Hi)) AND WordRec(Flags).Lo; { Hold current state }
  2339. Dec(CurState); { One down }
  2340. If (CurState >= SelRange) OR (CurState < 0) Then
  2341. CurState := SelRange - 1; { Roll if needed }
  2342. Value := (Value AND NOT (LongInt(WordRec(Flags).Lo)
  2343. SHL (Word(Item) * WordRec(Flags).Hi))) OR
  2344. (LongInt(CurState) SHL (Word(Item) *
  2345. WordRec(Flags).Hi)); { Calculate value }
  2346. Inherited Press(Item); { Call ancestor }
  2347. END;
  2348. {--TMultiCheckBoxes---------------------------------------------------------}
  2349. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2350. {---------------------------------------------------------------------------}
  2351. PROCEDURE TMultiCheckBoxes.GetData (Var Rec);
  2352. BEGIN
  2353. Longint(Rec) := Value; { Return value }
  2354. END;
  2355. {--TMultiCheckBoxes---------------------------------------------------------}
  2356. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2357. {---------------------------------------------------------------------------}
  2358. PROCEDURE TMultiCheckBoxes.SetData (Var Rec);
  2359. BEGIN
  2360. Value := Longint(Rec); { Set value }
  2361. SetDrawMask(vdFocus OR vdInner); { Set redraw mask }
  2362. DrawView; { Redraw masked areas }
  2363. END;
  2364. {--TMultiCheckBoxes---------------------------------------------------------}
  2365. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2366. {---------------------------------------------------------------------------}
  2367. PROCEDURE TMultiCheckBoxes.Store (Var S: TStream);
  2368. BEGIN
  2369. TCluster.Store(S); { TCluster store called }
  2370. S.Write(SelRange, SizeOf(SelRange)); { Write select range }
  2371. S.Write(Flags, SizeOf(Flags)); { Write select flags }
  2372. S.WriteStr(States); { Write strings }
  2373. END;
  2374. {$IFNDEF OS_DOS} { WIN/NT/OS2 CODE }
  2375. {***************************************************************************}
  2376. { TMultiCheckBoxes OBJECT WIN/NT/OS2 ONLY METHODS }
  2377. {***************************************************************************}
  2378. {--TMultiCheckBoxes---------------------------------------------------------}
  2379. { SubClassAttr -> Platforms WIN/NT/OS2 - Updated 06Jun98 LdB }
  2380. {---------------------------------------------------------------------------}
  2381. FUNCTION TMultiCheckBoxes.SubClassAttr: LongInt;
  2382. BEGIN
  2383. SubClassAttr := Inherited SubClassAttr OR
  2384. bs_CheckBox; { Check box buttons }
  2385. END;
  2386. {$ENDIF}
  2387. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2388. { TListBox OBJECT METHODS }
  2389. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2390. TYPE
  2391. TListBoxRec = PACKED RECORD
  2392. List: PCollection; { List collection ptr }
  2393. Selection: Word; { Selected item }
  2394. END;
  2395. {--TListBox-----------------------------------------------------------------}
  2396. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2397. {---------------------------------------------------------------------------}
  2398. CONSTRUCTOR TListBox.Init (Var Bounds: TRect; ANumCols: Word;
  2399. AScrollBar: PScrollBar);
  2400. BEGIN
  2401. Inherited Init(Bounds, ANumCols, Nil, AScrollBar); { Call ancestor }
  2402. SetRange(0); { Set range to zero }
  2403. END;
  2404. {--TListBox-----------------------------------------------------------------}
  2405. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2406. {---------------------------------------------------------------------------}
  2407. CONSTRUCTOR TListBox.Load (Var S: TStream);
  2408. BEGIN
  2409. Inherited Load(S); { Call ancestor }
  2410. List := PCollection(S.Get); { Fetch collection }
  2411. END;
  2412. {--TListBox-----------------------------------------------------------------}
  2413. { DataSize -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 06Jun98 LdB }
  2414. {---------------------------------------------------------------------------}
  2415. FUNCTION TListBox.DataSize: Word;
  2416. BEGIN
  2417. DataSize := SizeOf(TListBoxRec); { Xchg data size }
  2418. END;
  2419. {--TListBox-----------------------------------------------------------------}
  2420. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2421. {---------------------------------------------------------------------------}
  2422. FUNCTION TListBox.GetText (Item: Integer; MaxLen: Integer): String;
  2423. VAR P: PString;
  2424. BEGIN
  2425. GetText := ''; { Preset return }
  2426. If (List <> Nil) Then Begin { A list exists }
  2427. P := PString(List^.At(Item)); { Get string ptr }
  2428. If (P <> Nil) Then GetText := P^; { Return string }
  2429. End;
  2430. END;
  2431. {--TListBox-----------------------------------------------------------------}
  2432. { NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2433. {---------------------------------------------------------------------------}
  2434. PROCEDURE TListBox.NewList (AList: PCollection);
  2435. {$IFDEF OS_WINDOWS} VAR I: Integer; S: String; P: PString; {$ENDIF}
  2436. BEGIN
  2437. If (List <> Nil) Then Dispose(List, Done); { Dispose old list }
  2438. List := AList; { Hold new list }
  2439. If (AList <> Nil) Then SetRange(AList^.Count) { Set new item range }
  2440. Else SetRange(0); { Set zero range }
  2441. If (Range > 0) Then FocusItem(0); { Focus first item }
  2442. DrawView; { Redraw all view }
  2443. END;
  2444. {--TListBox-----------------------------------------------------------------}
  2445. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2446. {---------------------------------------------------------------------------}
  2447. PROCEDURE TListBox.GetData (Var Rec);
  2448. BEGIN
  2449. TListBoxRec(Rec).List := List; { Return current list }
  2450. TListBoxRec(Rec).Selection := Focused; { Return focused item }
  2451. END;
  2452. {--TListBox-----------------------------------------------------------------}
  2453. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2454. {---------------------------------------------------------------------------}
  2455. PROCEDURE TListBox.SetData (Var Rec);
  2456. BEGIN
  2457. NewList(TListBoxRec(Rec).List); { Hold new list }
  2458. FocusItem(TListBoxRec(Rec).Selection); { Focus selected item }
  2459. DrawView; { Redraw all view }
  2460. END;
  2461. {--TListBox-----------------------------------------------------------------}
  2462. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2463. {---------------------------------------------------------------------------}
  2464. PROCEDURE TListBox.Store (Var S: TStream);
  2465. BEGIN
  2466. TListViewer.Store(S); { TListViewer store }
  2467. S.Put(List); { Store list to stream }
  2468. END;
  2469. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2470. { TStaticText OBJECT METHODS }
  2471. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2472. {--TStaticText--------------------------------------------------------------}
  2473. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2474. {---------------------------------------------------------------------------}
  2475. CONSTRUCTOR TStaticText.Init (Var Bounds: TRect; Const AText: String);
  2476. BEGIN
  2477. Inherited Init(Bounds); { Call ancestor }
  2478. Text := NewStr(AText); { Create string ptr }
  2479. END;
  2480. {--TStaticText--------------------------------------------------------------}
  2481. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2482. {---------------------------------------------------------------------------}
  2483. CONSTRUCTOR TStaticText.Load (Var S: TStream);
  2484. BEGIN
  2485. Inherited Load(S); { Call ancestor }
  2486. Text := S.ReadStr; { Read text string }
  2487. END;
  2488. {--TStaticText--------------------------------------------------------------}
  2489. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2490. {---------------------------------------------------------------------------}
  2491. DESTRUCTOR TStaticText.Done;
  2492. BEGIN
  2493. If (Text <> Nil) Then DisposeStr(Text); { Dispose string }
  2494. Inherited Done; { Call ancestor }
  2495. END;
  2496. {--TStaticText--------------------------------------------------------------}
  2497. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2498. {---------------------------------------------------------------------------}
  2499. FUNCTION TStaticText.GetPalette: PPalette;
  2500. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  2501. CONST P: String = CStaticText; { Possible huge string }
  2502. {$ELSE} { OTHER COMPILERS }
  2503. CONST P: String[Length(CStaticText)] = CStaticText; { Always normal string }
  2504. {$ENDIF}
  2505. BEGIN
  2506. GetPalette := @P; { Return palette }
  2507. END;
  2508. {--TStaticText--------------------------------------------------------------}
  2509. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2510. {---------------------------------------------------------------------------}
  2511. PROCEDURE TStaticText.DrawBackGround;
  2512. VAR Just: Byte; I, J, P, Y, L: Integer; S, T: String;
  2513. BEGIN
  2514. Inherited DrawBackGround; { Call ancestor }
  2515. GetText(S); { Fetch text to write }
  2516. P := 1; { X start position }
  2517. Y := 0; { Y start position }
  2518. L := Length(S); { Length of text }
  2519. While (Y < Size.Y) AND (P <= L) Do Begin
  2520. Just := 0; { Default left justify }
  2521. If (S[P] = #2) Then Begin { Right justify char }
  2522. Just := 2; { Set right justify }
  2523. Inc(P); { Next character }
  2524. End;
  2525. If (S[P] = #3) Then Begin { Centre justify char }
  2526. Just := 1; { Set centre justify }
  2527. Inc(P); { Next character }
  2528. End;
  2529. I := P; { Start position }
  2530. While (P <= L) AND (S[P] <> #13) Do Inc(P); { Scan for end }
  2531. T := Copy(S, I, P-I); { String to write }
  2532. Case Just Of
  2533. 0: J := 0; { Left justify }
  2534. 1: J := (RawSize.X - TextWidth(T)) DIV 2; { Centre justify }
  2535. 2: J := RawSize.X - TextWidth(T); { Right justify }
  2536. End;
  2537. While (J < 0) Do Begin { Text to long }
  2538. J := J + TextWidth(T[1]); { Add width to J }
  2539. Delete(T, 1, 1); { Delete the char }
  2540. End;
  2541. WriteStr(-J, -(Y*FontHeight), T, 1); { Write the text }
  2542. While (P <= L) AND ((S[P] = #13) OR (S[P] = #10))
  2543. Do Inc(P); { Remove CR/LF }
  2544. Inc(Y); { Next line }
  2545. End;
  2546. END;
  2547. {--TStaticText--------------------------------------------------------------}
  2548. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2549. {---------------------------------------------------------------------------}
  2550. PROCEDURE TStaticText.Store (Var S: TStream);
  2551. BEGIN
  2552. TView.Store(S); { Call TView store }
  2553. S.WriteStr(Text); { Write text string }
  2554. END;
  2555. {--TStaticText--------------------------------------------------------------}
  2556. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2557. {---------------------------------------------------------------------------}
  2558. PROCEDURE TStaticText.GetText (Var S: String);
  2559. BEGIN
  2560. If (Text <> Nil) Then S := Text^ { Copy text string }
  2561. Else S := ''; { Return empty string }
  2562. END;
  2563. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2564. { TParamText OBJECT METHODS }
  2565. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2566. {--TParamText---------------------------------------------------------------}
  2567. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2568. {---------------------------------------------------------------------------}
  2569. CONSTRUCTOR TParamText.Init (Var Bounds: TRect; Const AText: String;
  2570. AParamCount: Integer);
  2571. BEGIN
  2572. Inherited Init(Bounds, AText); { Call ancestor }
  2573. ParamCount := AParamCount; { Hold param count }
  2574. END;
  2575. {--TParamText---------------------------------------------------------------}
  2576. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2577. {---------------------------------------------------------------------------}
  2578. CONSTRUCTOR TParamText.Load (Var S: TStream);
  2579. BEGIN
  2580. Inherited Load(S); { Call ancestor }
  2581. S.Read(ParamCount, 2); { Read parameter count }
  2582. END;
  2583. {--TParamText---------------------------------------------------------------}
  2584. { DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2585. {---------------------------------------------------------------------------}
  2586. FUNCTION TParamText.DataSize: Word;
  2587. BEGIN
  2588. DataSize := ParamCount * SizeOf(Pointer); { Return data size }
  2589. END;
  2590. {--TParamText---------------------------------------------------------------}
  2591. { GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2592. {---------------------------------------------------------------------------}
  2593. PROCEDURE TParamText.GetData (Var Rec);
  2594. BEGIN
  2595. Pointer(Rec) := @ParamList; { Return parm ptr }
  2596. END;
  2597. {--TParamText---------------------------------------------------------------}
  2598. { SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
  2599. {---------------------------------------------------------------------------}
  2600. PROCEDURE TParamText.SetData (Var Rec);
  2601. BEGIN
  2602. ParamList := @Rec; { Fetch parameter list }
  2603. DrawView; { Redraw all the view }
  2604. END;
  2605. {--TParamText---------------------------------------------------------------}
  2606. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2607. {---------------------------------------------------------------------------}
  2608. PROCEDURE TParamText.Store (Var S: TStream);
  2609. BEGIN
  2610. TStaticText.Store(S); { Statictext store }
  2611. S.Write(ParamCount, 2); { Store param count }
  2612. END;
  2613. {--TParamText---------------------------------------------------------------}
  2614. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2615. {---------------------------------------------------------------------------}
  2616. PROCEDURE TParamText.GetText (Var S: String);
  2617. BEGIN
  2618. If (Text = Nil) Then S := '' Else { Return empty string }
  2619. FormatStr(S, Text^, ParamList^); { Return text string }
  2620. END;
  2621. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2622. { TLabel OBJECT METHODS }
  2623. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2624. {--TLabel-------------------------------------------------------------------}
  2625. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2626. {---------------------------------------------------------------------------}
  2627. CONSTRUCTOR TLabel.Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
  2628. BEGIN
  2629. Inherited Init(Bounds, AText); { Call ancestor }
  2630. Link := ALink; { Hold link }
  2631. Options := Options OR (ofPreProcess+ofPostProcess);{ Set pre/post process }
  2632. EventMask := EventMask OR evBroadcast; { Sees broadcast events }
  2633. END;
  2634. {--TLabel-------------------------------------------------------------------}
  2635. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2636. {---------------------------------------------------------------------------}
  2637. CONSTRUCTOR TLabel.Load (Var S: TStream);
  2638. BEGIN
  2639. Inherited Load(S); { Call ancestor }
  2640. GetPeerViewPtr(S, Link); { Load link view }
  2641. END;
  2642. {--TLabel-------------------------------------------------------------------}
  2643. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2644. {---------------------------------------------------------------------------}
  2645. FUNCTION TLabel.GetPalette: PPalette;
  2646. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  2647. CONST P: String = CLabel; { Possible huge string }
  2648. {$ELSE} { OTHER COMPILERS }
  2649. CONST P: String[Length(CLabel)] = CLabel; { Always normal string }
  2650. {$ENDIF}
  2651. BEGIN
  2652. GetPalette := @P; { Return palette }
  2653. END;
  2654. {--TLabel-------------------------------------------------------------------}
  2655. { DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2656. {---------------------------------------------------------------------------}
  2657. PROCEDURE TLabel.DrawBackGround;
  2658. VAR SCOff: Byte; Color: Word; B: TDrawBuffer;
  2659. BEGIN
  2660. TView.DrawBackGround; { Explict call to TView }
  2661. If Light Then Begin { Light colour select }
  2662. Color := GetColor($0402); { Choose light colour }
  2663. SCOff := 0; { Zero offset }
  2664. End Else Begin
  2665. Color := GetColor($0301); { Darker colour }
  2666. SCOff := 4; { Set offset }
  2667. End;
  2668. MoveChar(B[0], ' ', Byte(Color), Size.X); { Clear the buffer }
  2669. If (Text <> Nil) Then MoveCStr(B[1], Text^, Color);{ Transfer label text }
  2670. If ShowMarkers Then WordRec(B[0]).Lo := Byte(
  2671. SpecialChars[SCOff]); { Show marker if req }
  2672. WriteLine(0, 0, Size.X, 1, B); { Write the text }
  2673. END;
  2674. {--TLabel-------------------------------------------------------------------}
  2675. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2676. {---------------------------------------------------------------------------}
  2677. PROCEDURE TLabel.Store (Var S: TStream);
  2678. BEGIN
  2679. TStaticText.Store(S); { TStaticText.Store }
  2680. PutPeerViewPtr(S, Link); { Store link view }
  2681. END;
  2682. {--TLabel-------------------------------------------------------------------}
  2683. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2684. {---------------------------------------------------------------------------}
  2685. PROCEDURE TLabel.HandleEvent (Var Event: TEvent);
  2686. VAR C: Char;
  2687. PROCEDURE FocusLink;
  2688. BEGIN
  2689. If (Link <> Nil) AND (Link^.Options AND
  2690. ofSelectable <> 0) Then Link^.Focus; { Focus link view }
  2691. ClearEvent(Event); { Clear the event }
  2692. END;
  2693. BEGIN
  2694. Inherited HandleEvent(Event); { Call ancestor }
  2695. Case Event.What Of
  2696. evNothing: Exit; { Speed up exit }
  2697. evMouseDown: FocusLink; { Focus link view }
  2698. evKeyDown: Begin
  2699. C := HotKey(Text^); { Check for hotkey }
  2700. If (GetAltCode(C) = Event.KeyCode) OR { Alt plus char }
  2701. ((C <> #0) AND (Owner^.Phase = phPostProcess) { Post process phase }
  2702. AND (UpCase(Event.CharCode) = C)) Then { Upper case match }
  2703. FocusLink; { Focus link view }
  2704. End;
  2705. evBroadcast: If ((Event.Command = cmReceivedFocus)
  2706. OR (Event.Command = cmReleasedFocus)) AND { Focus state change }
  2707. (Link <> Nil) Then Begin
  2708. Light := Link^.State AND sfFocused <> 0; { Change light state }
  2709. DrawView; { Now redraw change }
  2710. End;
  2711. End;
  2712. END;
  2713. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2714. { THistoryViewer OBJECT METHODS }
  2715. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2716. {--THistoryViewer-----------------------------------------------------------}
  2717. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2718. {---------------------------------------------------------------------------}
  2719. CONSTRUCTOR THistoryViewer.Init (Var Bounds: TRect; AHScrollBar,
  2720. AVScrollBar: PScrollBar; AHistoryId: Word);
  2721. BEGIN
  2722. Inherited Init(Bounds, 1, AHScrollBar,
  2723. AVScrollBar); { Call ancestor }
  2724. HistoryId := AHistoryId; { Hold history id }
  2725. SetRange(HistoryCount(AHistoryId)); { Set history range }
  2726. If (Range > 1) Then FocusItem(1); { Set to item 1 }
  2727. If (HScrollBar <> Nil) Then
  2728. HScrollBar^.SetRange(1, HistoryWidth-Size.X + 3);{ Set scrollbar range }
  2729. END;
  2730. {--THistoryViewer-----------------------------------------------------------}
  2731. { HistoryWidth -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2732. {---------------------------------------------------------------------------}
  2733. FUNCTION THistoryViewer.HistoryWidth: Integer;
  2734. VAR Width, T, Count, I: Integer;
  2735. BEGIN
  2736. Width := 0; { Zero width variable }
  2737. Count := HistoryCount(HistoryId); { Hold count value }
  2738. For I := 0 To Count-1 Do Begin { For each item }
  2739. T := Length(HistoryStr(HistoryId, I)); { Get width of item }
  2740. If (T > Width) Then Width := T; { Set width to max }
  2741. End;
  2742. HistoryWidth := Width; { Return max item width }
  2743. END;
  2744. {--THistoryViewer-----------------------------------------------------------}
  2745. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2746. {---------------------------------------------------------------------------}
  2747. FUNCTION THistoryViewer.GetPalette: PPalette;
  2748. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  2749. CONST P: String = CHistoryViewer; { Possible huge string }
  2750. {$ELSE} { OTHER COMPILERS }
  2751. CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
  2752. {$ENDIF}
  2753. BEGIN
  2754. GetPalette := @P; { Return palette }
  2755. END;
  2756. {--THistoryViewer-----------------------------------------------------------}
  2757. { GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2758. {---------------------------------------------------------------------------}
  2759. FUNCTION THistoryViewer.GetText (Item: Integer; MaxLen: Integer): String;
  2760. BEGIN
  2761. GetText := HistoryStr(HistoryId, Item); { Return history string }
  2762. END;
  2763. {--THistoryViewer-----------------------------------------------------------}
  2764. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2765. {---------------------------------------------------------------------------}
  2766. PROCEDURE THistoryViewer.HandleEvent (Var Event: TEvent);
  2767. BEGIN
  2768. If ((Event.What = evMouseDown) AND (Event.Double)) { Double click mouse }
  2769. OR ((Event.What = evKeyDown) AND
  2770. (Event.KeyCode = kbEnter)) Then Begin { Enter key press }
  2771. EndModal(cmOk); { End with cmOk }
  2772. ClearEvent(Event); { Event was handled }
  2773. End Else If ((Event.What = evKeyDown) AND
  2774. (Event.KeyCode = kbEsc)) OR { Esc key press }
  2775. ((Event.What = evCommand) AND
  2776. (Event.Command = cmCancel)) Then Begin { Cancel command }
  2777. EndModal(cmCancel); { End with cmCancel }
  2778. ClearEvent(Event); { Event was handled }
  2779. End Else Inherited HandleEvent(Event); { Call ancestor }
  2780. END;
  2781. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2782. { THistoryWindow OBJECT METHODS }
  2783. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2784. {--THistoryWindow-----------------------------------------------------------}
  2785. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2786. {---------------------------------------------------------------------------}
  2787. CONSTRUCTOR THistoryWindow.Init (Var Bounds: TRect; HistoryId: Word);
  2788. BEGIN
  2789. Inherited Init(Bounds, '', wnNoNumber); { Call ancestor }
  2790. Flags := wfClose; { Close flag only }
  2791. InitViewer(HistoryId); { Create list view }
  2792. END;
  2793. {--THistoryWindow-----------------------------------------------------------}
  2794. { GetSelection -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2795. {---------------------------------------------------------------------------}
  2796. FUNCTION THistoryWindow.GetSelection: String;
  2797. BEGIN
  2798. If (Viewer = Nil) Then GetSelection := '' Else { Return empty string }
  2799. GetSelection := Viewer^.GetText(Viewer^.Focused,
  2800. 255); { Get focused string }
  2801. END;
  2802. {--THistoryWindow-----------------------------------------------------------}
  2803. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2804. {---------------------------------------------------------------------------}
  2805. FUNCTION THistoryWindow.GetPalette: PPalette;
  2806. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  2807. CONST P: String = CHistoryWindow; { Possible huge string }
  2808. {$ELSE} { OTHER COMPILERS }
  2809. CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
  2810. {$ENDIF}
  2811. BEGIN
  2812. GetPalette := @P; { Return the palette }
  2813. END;
  2814. {--THistoryWindow-----------------------------------------------------------}
  2815. { InitViewer -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2816. {---------------------------------------------------------------------------}
  2817. PROCEDURE THistoryWindow.InitViewer(HistoryId: Word);
  2818. VAR R: TRect;
  2819. BEGIN
  2820. GetExtent(R); { Get extents }
  2821. R.Grow(-1,-1); { Grow inside }
  2822. Viewer := New(PHistoryViewer, Init(R,
  2823. StandardScrollBar(sbHorizontal + sbHandleKeyboard),
  2824. StandardScrollBar(sbVertical + sbHandleKeyboard),
  2825. HistoryId)); { Create the viewer }
  2826. If (Viewer <> Nil) Then Insert(Viewer); { Insert viewer }
  2827. END;
  2828. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2829. { THistory OBJECT METHODS }
  2830. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2831. {--THistory-----------------------------------------------------------------}
  2832. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2833. {---------------------------------------------------------------------------}
  2834. CONSTRUCTOR THistory.Init (Var Bounds: TRect; ALink: PInputLine;
  2835. AHistoryId: Word);
  2836. BEGIN
  2837. Inherited Init(Bounds); { Call ancestor }
  2838. Options := Options OR ofPostProcess; { Set post process }
  2839. EventMask := EventMask OR evBroadcast; { See broadcast events }
  2840. Link := ALink; { Hold link view }
  2841. HistoryId := AHistoryId; { Hold history id }
  2842. END;
  2843. {--THistory-----------------------------------------------------------------}
  2844. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2845. {---------------------------------------------------------------------------}
  2846. CONSTRUCTOR THistory.Load (Var S: TStream);
  2847. BEGIN
  2848. Inherited Load(S); { Call ancestor }
  2849. GetPeerViewPtr(S, Link); { Load link view }
  2850. S.Read(HistoryId, 2); { Read history id }
  2851. END;
  2852. {--THistory-----------------------------------------------------------------}
  2853. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2854. {---------------------------------------------------------------------------}
  2855. FUNCTION THistory.GetPalette: PPalette;
  2856. {$IFDEF PPC_DELPHI3} { DELPHI3+ COMPILER }
  2857. CONST P: String = CHistory; { Possible huge string }
  2858. {$ELSE} { OTHER COMPILERS }
  2859. CONST P: String[Length(CHistory)] = CHistory; { Always normal string }
  2860. {$ENDIF}
  2861. BEGIN
  2862. GetPalette := @P; { Return the palette }
  2863. END;
  2864. {--THistory-----------------------------------------------------------------}
  2865. { InitHistoryWindow -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2866. {---------------------------------------------------------------------------}
  2867. FUNCTION THistory.InitHistoryWindow (Var Bounds: TRect): PHistoryWindow;
  2868. VAR P: PHistoryWindow;
  2869. BEGIN
  2870. P := New(PHistoryWindow, Init(Bounds, HistoryId)); { Create history window }
  2871. If (Link <> Nil) Then
  2872. P^.HelpCtx := Link^.HelpCtx; { Set help context }
  2873. InitHistoryWindow := P; { Return history window }
  2874. END;
  2875. PROCEDURE THistory.Draw;
  2876. VAR B: TDrawBuffer;
  2877. BEGIN
  2878. MoveCStr(B, #222'~'#25'~'#221, GetColor($0102)); { Set buffer data }
  2879. WriteLine(0, 0, Size.X, Size.Y, B); { Write buffer }
  2880. END;
  2881. {--THistory-----------------------------------------------------------------}
  2882. { RecordHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2883. {---------------------------------------------------------------------------}
  2884. PROCEDURE THistory.RecordHistory (CONST S: String);
  2885. BEGIN
  2886. HistoryAdd(HistoryId, S); { Add to history }
  2887. END;
  2888. {--THistory-----------------------------------------------------------------}
  2889. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2890. {---------------------------------------------------------------------------}
  2891. PROCEDURE THistory.Store (Var S: TStream);
  2892. BEGIN
  2893. TView.Store(S); { TView.Store called }
  2894. PutPeerViewPtr(S, Link); { Store link view }
  2895. S.Write(HistoryId, 2); { Store history id }
  2896. END;
  2897. {--THistory-----------------------------------------------------------------}
  2898. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
  2899. {---------------------------------------------------------------------------}
  2900. PROCEDURE THistory.HandleEvent (Var Event: TEvent);
  2901. VAR C: Word; Rslt: String; R, P: TRect; HistoryWindow: PHistoryWindow;
  2902. BEGIN
  2903. Inherited HandleEvent(Event); { Call ancestor }
  2904. If (Link = Nil) Then Exit; { No link view exits }
  2905. If (Event.What = evMouseDown) OR { Mouse down event }
  2906. ((Event.What = evKeyDown) AND
  2907. (CtrlToArrow(Event.KeyCode) = kbDown) AND { Down arrow key }
  2908. (Link^.State AND sfFocused <> 0)) Then Begin { Link view selected }
  2909. If NOT Link^.Focus Then Begin
  2910. ClearEvent(Event); { Event was handled }
  2911. Exit; { Now exit }
  2912. End;
  2913. RecordHistory(Link^.Data^); { Record current data }
  2914. Link^.GetBounds(R); { Get view bounds }
  2915. Dec(R.A.X); { One char in from us }
  2916. Inc(R.B.X); { One char short of us }
  2917. Inc(R.B.Y, 7); { Seven lines down }
  2918. Dec(R.A.Y,1); { One line below us }
  2919. Owner^.GetExtent(P); { Get owner extents }
  2920. R.Intersect(P); { Intersect views }
  2921. Dec(R.B.Y,1); { Shorten length by one }
  2922. HistoryWindow := InitHistoryWindow(R); { Create history window }
  2923. If (HistoryWindow <> Nil) Then Begin { Window crested okay }
  2924. C := Owner^.ExecView(HistoryWindow); { Execute this window }
  2925. If (C = cmOk) Then Begin { Result was okay }
  2926. Rslt := HistoryWindow^.GetSelection; { Get history selection }
  2927. If Length(Rslt) > Link^.MaxLen Then
  2928. {$IFDEF PPC_DELPHI3} { DELPHI 3+ COMPILER }
  2929. SetLength(Rslt, Link^.MaxLen); { Hold new length }
  2930. {$ELSE}
  2931. Rslt[0] := Char(Link^.MaxLen); { Hold new length }
  2932. {$ENDIF}
  2933. Link^.Data^ := Rslt; { Hold new selection }
  2934. Link^.SelectAll(True); { Select all string }
  2935. Link^.DrawView; { Redraw link view }
  2936. End;
  2937. Dispose(HistoryWindow, Done); { Dispose of window }
  2938. End;
  2939. ClearEvent(Event); { Event was handled }
  2940. End Else If (Event.What = evBroadcast) Then { Broadcast event }
  2941. If ((Event.Command = cmReleasedFocus) AND
  2942. (Event.InfoPtr = Link)) OR
  2943. (Event.Command = cmRecordHistory) Then { Record command }
  2944. RecordHistory(Link^.Data^); { Record the history }
  2945. END;
  2946. {***************************************************************************}
  2947. { INTERFACE ROUTINES }
  2948. {***************************************************************************}
  2949. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2950. { ITEM STRING ROUTINES }
  2951. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2952. {---------------------------------------------------------------------------}
  2953. { NewSItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
  2954. {---------------------------------------------------------------------------}
  2955. FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;
  2956. VAR Item: PSItem;
  2957. BEGIN
  2958. New(Item); { Allocate item }
  2959. Item^.Value := NewStr(Str); { Hold item string }
  2960. Item^.Next := ANext; { Chain the ptr }
  2961. NewSItem := Item; { Return item }
  2962. END;
  2963. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2964. { DIALOG OBJECT REGISTRATION ROUTINES }
  2965. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2966. {---------------------------------------------------------------------------}
  2967. { RegisterDialogs -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
  2968. {---------------------------------------------------------------------------}
  2969. PROCEDURE RegisterDialogs;
  2970. BEGIN
  2971. RegisterType(RDialog); { Register dialog }
  2972. RegisterType(RInputLine); { Register inputline }
  2973. RegisterType(RButton); { Register button }
  2974. RegisterType(RCluster); { Register cluster }
  2975. RegisterType(RRadioButtons); { Register radiobutton }
  2976. RegisterType(RCheckBoxes); { Register check boxes }
  2977. RegisterType(RMultiCheckBoxes); { Register multi boxes }
  2978. RegisterType(RListBox); { Register list box }
  2979. RegisterType(RStaticText); { Register static text }
  2980. RegisterType(RLabel); { Register label }
  2981. RegisterType(RHistory); { Register history }
  2982. RegisterType(RParamText); { Register parm text }
  2983. END;
  2984. END.
  2985. {
  2986. $Log$
  2987. Revision 1.2 2000-08-24 12:00:20 marco
  2988. * CVS log and ID tags
  2989. }