/packages/fv/src/statuses.pas

https://github.com/slibre/freepascal · Pascal · 1404 lines · 701 code · 107 blank · 596 comment · 43 complexity · 565dfe1f0d42ee9cf72e5324a8bb8735 MD5 · raw file

  1. {$V-}
  2. unit Statuses;
  3. {$CODEPAGE cp437}
  4. {#Z+}
  5. { Free Vision Status Objects Unit
  6. Free VIsion
  7. Written by : Brad Williams, DVM
  8. Revision History
  9. 1.2.3 (96/04/13)
  10. - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
  11. Resume "aware"
  12. - eliminated many bugs
  13. - moved Pause, Resume and Cancel from TStatusDlg to TStatus
  14. 1.2.1 (95/12/6)
  15. - minor typo corrections in opening unit documentation
  16. - F+ to Z+ around stream registration records
  17. - removed redundant sentence in TAppStatus definition
  18. - updated CBarStatus documentation and constant
  19. - removed TGauge.Init cross-reference from TSpinner.Init
  20. - added THeapMemAvail and RegistertvStatus documentation
  21. - numerous other documentation updates
  22. - changed all calls to Send to Message
  23. 1.2.0 (95/11/24)
  24. - conversion to Bsd format
  25. 1.1.0 (05/01/94)
  26. - initial WVS release
  27. Known Bugs
  28. ScanHelp Errors
  29. - sdXXXX constants help documentation doesn't show TStatusDlg and
  30. TMessageStatusDlg
  31. - ScanHelp produces garbage in evStatus help context
  32. tvStatus Bugs
  33. - CAppStatus may not be correct }
  34. {#Z-}
  35. { The tvStatus unit implements several views for providing information to
  36. the user which needs to be updated during program execution, such as a
  37. progress indicator, clock, heap viewer, gauges, etc. All tvStatus views
  38. respond to a new message event class, evStatus. An individual status view
  39. only processes an event with its associated command. }
  40. interface
  41. {$i platform.inc}
  42. {$ifdef PPC_FPC}
  43. {$H-}
  44. {$else}
  45. {$F+,O+,E+,N+}
  46. {$endif}
  47. {$X+,R-,I-,Q-,V-}
  48. {$ifndef OS_UNIX}
  49. {$S-}
  50. {$endif}
  51. uses
  52. FVCommon, FVConsts, Objects, Drivers, Views, Dialogs;
  53. { Resource;}
  54. const
  55. evStatus = $8000;
  56. { evStatus represents the event class all status views know how to
  57. respond to. }
  58. {#X Statuses }
  59. CStatus = #1#2#3;
  60. {$ifndef cdPrintDoc}
  61. {#F+}
  62. {ÝTStatus.CStatus palette
  63. ßßßßßßßßßßßßßßßßßßßßßßßßß}
  64. {#F-}
  65. {$endif cdPrintDoc}
  66. { Status views use the default palette, CStatus, to map onto the first three
  67. entries in the standard window palette. }
  68. {#F+}
  69. { 1 2 3
  70. ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
  71. CStatus º 1 ³ 2 ³ 3 º
  72. ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
  73. Normal TextÄÄÄÙ ³ ³
  74. OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
  75. Highlighted TextÄÄÄÄÄÄÄÄÙ }
  76. {#F-}
  77. {#X TStatus }
  78. CAppStatus = #2#5#4;
  79. {$ifndef cdPrintDoc}
  80. {#F+}
  81. {ÝTAppStatus.CAppStatus palette
  82. ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
  83. {#F-}
  84. {$endif cdPrintDoc}
  85. { Status views which are inserted into the application rather than a dialog
  86. or window use the default palette, CAppStatus, to map onto the application
  87. object's palette. }
  88. {#F+}
  89. { 1 2 3
  90. ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
  91. CAppStatus º 2 ³ 5 ³ 4 º
  92. ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
  93. Normal TextÄÄÄÄÄÄÙ ³ ³
  94. OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
  95. Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
  96. {#F-}
  97. {#X tvStatus TAppStatus }
  98. CBarGauge = CStatus + #16#19;
  99. {$ifndef cdPrintDoc}
  100. {#F+}
  101. {ÝTBarGauge.CBarGauge palette
  102. ßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
  103. {#F-}
  104. {$endif cdPrintDoc}
  105. { TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
  106. window owner's palette. }
  107. {#F+}
  108. { 1 2 3 4 5
  109. ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
  110. CAppStatus º 2 ³ 5 ³ 4 ³ 16 ³ 19 º
  111. ÈÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
  112. Normal TextÄÄÄÄÄÄÙ ³ ³ ³ ÀÄÄÄÄ filled in bar
  113. OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³ ÀÄÄÄÄÄÄÄÄÄ empty bar
  114. Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
  115. {#F-}
  116. {#X tvStatus TBarGauge }
  117. {#T sdXXXX }
  118. {$ifndef cdPrintDoc}
  119. {#F+}
  120. {ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
  121. Ý sdXXXX constants (STDDLG unit) Þ
  122. ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
  123. {#F-}
  124. {$endif cdNoPrintDoc}
  125. { sdXXXX constants are used to determine the types of buttons displayed in a
  126. #TStatusDlg# or #TStatusMessageDlg#. }
  127. {#F+}
  128. { Constant ³ Value ³ Meaning
  129. ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
  130. sdNone ³ $0000 ³ no buttons
  131. sdCancelButton ³ $0001 ³ show Cancel button
  132. sdPauseButton ³ $0002 ³ show Pause button
  133. sdResumeButton ³ $0004 ³ show Resume button
  134. sdAllButtons ³ $0008 ³ show Cancel, Pause and Resume
  135. ³ ³ buttons }
  136. {#Z+}
  137. sdNone = $0000;
  138. sdCancelButton = $0001;
  139. sdPauseButton = $0002;
  140. sdResumeButton = $0004;
  141. sdAllButtons = sdCancelButton or sdPauseButton or sdResumeButton;
  142. {#Z-}
  143. {#X tvStatus TStatusDlg TStatusMessageDlg }
  144. SpinChars : String[4] = '³/Ä\';
  145. { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
  146. Only one character is displayed at a time. The string is cycled
  147. through then started over again until the view is disposed. }
  148. {#X tvStatus }
  149. sfPause = $F000;
  150. { sfPause is an additional state flag used internally by status views to
  151. indicate they are in a paused state and should not respond to their
  152. command. }
  153. type
  154. {#Z+}
  155. PStatus = ^TStatus;
  156. {#Z-}
  157. TStatus = Object(TParamText)
  158. { TStatus is the base object type from which all status views descend.
  159. Status views are used to display information that will change at
  160. run-time based upon some state or process in the application, such as
  161. printing.
  162. All status views that are to be inserted into the application should
  163. descend from #TAppStatus# for proper color mapping. }
  164. Command : Word;
  165. { Command is the only command the status view will respond to. When
  166. the status view receives an evStatus event it checks the value of the
  167. Event.Command field against Command before handling the event. }
  168. {#X HandleEvent }
  169. constructor Init (R : TRect; ACommand : Word; AText : String;
  170. AParamCount : Integer);
  171. { Init calls the inherited constructor then sets #Command# to ACommand.
  172. If an error occurs Init fails. }
  173. {#X Load }
  174. constructor Load (var S : TStream);
  175. { Load calls the inherited constructor then reads #Command# from the
  176. stream.
  177. If an error occurs Load fails. }
  178. {#X Store Init }
  179. function Cancel : Boolean; virtual;
  180. { Cancel should prompt the user when necessary for validation of
  181. canceling the process which the status view is displaying. If the
  182. user elects to continue the process Cancel must return False,
  183. otherwise Cancel must return True. }
  184. {#X Pause Resume }
  185. function GetPalette : PPalette; virtual;
  186. { GetPalette returns a pointer to the default status view palette,
  187. #CStatus#. }
  188. {#X TAppStatus CAppStatus }
  189. procedure HandleEvent (var Event : TEvent); virtual;
  190. { HandleEvent captures any #evStatus# messages with its command value
  191. equal to #Command#, then calls #Update# with Data set to
  192. Event.InfoPtr. If the State field has its #sfPause# bit set, the
  193. view ignores the event. }
  194. procedure Pause; virtual;
  195. { Pause sends an evStatus message to the application with Event.Command
  196. set to cmStatusPause and Event.InfoPtr set to #Status#^.Command. The
  197. #Status# view's sfPause bit of the State flag is set by calling
  198. SetState. In the paused state, the status view does not respond to
  199. its associated command. }
  200. {#X Resume sdXXXX Cancel }
  201. procedure Reset; virtual;
  202. { Reset causes the status view to be reset to its beginning or default
  203. value, then be redrawn. Reset is used after an event is aborted
  204. which can only be performed in its entirety. }
  205. procedure Resume; virtual;
  206. { Resume is called in response to pressing the Resume button. Resume
  207. sends an evStatus message to the application with Event.Command set
  208. to cmStatusPause and Event.InfoPtr set to #Status#^.Command. The
  209. Status view's sfPause bit is turned off by calling SetState. }
  210. {#X Pause sdXXXX Cancel }
  211. procedure Store (var S : TStream); { store should never be virtual;}
  212. { Store calls the inherited Store method then writes #Command# to the
  213. stream. }
  214. {#X Load }
  215. procedure Update (Data : Pointer); virtual;
  216. { Update changes the status' displayed text as necessary based on
  217. Data. }
  218. {#X Command HandleEvent }
  219. end; { of TStatus }
  220. {#Z+}
  221. PStatusDlg = ^TStatusDlg;
  222. {#Z-}
  223. TStatusDlg = Object(TDialog)
  224. { A TStatusDlg displays a status view and optional buttons. It may be
  225. used to display any status message and optionally provide end user
  226. cancelation or pausing of an ongoing operation, such as printing.
  227. All status views that are to be inserted into a window or dialog should
  228. descend from #TStatus# for proper color mapping. }
  229. Status : PStatus;
  230. { Status is the key status view for the dialog. When a cmStatusPause
  231. command is broadcast in response to pressing the pause button,
  232. Event.InfoPtr is set to point to the command associated with Status. }
  233. {#X TStatus cmXXXX }
  234. constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
  235. { Init calls the inherited constructor to create the dialog and sets
  236. the EventMask to handle #evStatus# events. AStatus is assigned to
  237. #Status# and inserted into the dialog at position 2,2.
  238. The dialog is anchored at AStatus^.Origin and its size is at least
  239. AStatus^.Size + 2 in both dimensions. The actual size is determined
  240. by the AFlags byte. The #sdXXXX# constants should be used to signify
  241. which buttons to display.
  242. If an error occurs Init fails. }
  243. {#X TStatus.Pause TStatus.Resume }
  244. constructor Load (var S : TStream);
  245. { Load calls the inherited constructor then loads #Status#.
  246. If an error occurs Load fails. }
  247. {#X Store }
  248. procedure Cancel (ACommand : Word); virtual;
  249. { Cancel sends an evStatus message to the Application object with
  250. command set to cmCancel and InfoPtr set to the calling status view's
  251. command, then calls the inherited Cancel method. }
  252. {#X TBSDDialog.Cancel }
  253. procedure HandleEvent (var Event : TEvent); virtual;
  254. { All evStatus events are accepted by the dialog and sent to each
  255. subview in Z-order until cleared.
  256. If the dialog recieves an evCommand or evBroadcast event with the
  257. Command parameter set to cmCancel, HandleEvent sends an #evStatus#
  258. message to the Application variable with Event.Command set to the
  259. cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
  260. disposes of itself.
  261. When a pause button is included, a cmStatusPause broadcast event is
  262. associated with the button. When the button is pressed a call to
  263. #TStatus.Pause# results. The status view is inactivated until it
  264. receives an evStatus event with a commond of cmStatusResume and
  265. Event.InfoPtr set to the status view's Command value. When a pause
  266. button is used, the application should respond to the evStatus event
  267. (with Event.Command of cmStatusPause) appropriately, then dispatch a
  268. cmStatusResume evStatus event when ready to resume activity. }
  269. {#X TStatus.Command }
  270. procedure InsertButtons (AFlags : Word); virtual;
  271. { InsertButtons enlarges the dialog to the necessary size and inserts
  272. the buttons specified in AFlags into the last row of the dialog. }
  273. procedure Store (var S : TStream); { store should never be virtual;}
  274. { Store calls the inherited Store method then writes #Status# to the
  275. stream. }
  276. {#X Load }
  277. end; { of TStatusDlg }
  278. {#Z+}
  279. PStatusMessageDlg = ^TStatusMessageDlg;
  280. {#Z-}
  281. TStatusMessageDlg = Object(TStatusDlg)
  282. { A TStatusMessageDlg displays a message as static text with a status
  283. view on the line below it.
  284. All status views that are to be inserted into a window or dialog should
  285. descend from #TStatus# for proper color mapping. }
  286. constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
  287. AMessage : String);
  288. { Init calls the inherited constructor then inserts a TStaticText view
  289. containing AMessage at the top line of the dialog.
  290. The size of the dialog is determined by the size of the AStatus. The
  291. dialog is anchored at AStatus^.Origin and is of at least
  292. AStatus^.Size + 2 in heighth and width. The exact width and heighth
  293. are determined by AOptions.
  294. AFlags contains flags which determine the buttons to be displayed
  295. in the dialog.
  296. If an error occurs Init fails. }
  297. end; { of TStatusMessageDlg }
  298. {#Z+}
  299. PGauge = ^TGauge;
  300. {#Z-}
  301. TGauge = Object(TStatus)
  302. { A gauge is used to represent the current numerical position within a
  303. range of values. When Current equals Max a gauge dispatches an
  304. #evStatus# event with the command set to cmStatusDone to the
  305. Application object. }
  306. Min : LongInt;
  307. { Min is the minimum value which #Current# may be set to. }
  308. {#X Max }
  309. Max : LongInt;
  310. { Max is the maximum value which #Current# may be set to. }
  311. {#X Min }
  312. Current : LongInt;
  313. { Current is the current value represented in the gauge. }
  314. {#X Max Min }
  315. constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
  316. { Init calls the inherited constructor then sets #Min# and #Max# to
  317. AMin and AMax, respectively. #Current# is set to AMin.
  318. If an error occurs Init fails. }
  319. {#X Load }
  320. constructor Load (var S : TStream);
  321. { Load calls the inherited constructor then reads #Min#, #Max# and
  322. #Current# from the stream.
  323. If an error occurs Load fails. }
  324. {#X Init Store }
  325. procedure Draw; virtual;
  326. { Draw writes the following to the screen: }
  327. {#F+}
  328. {
  329. Min = XXX Max = XXX Current = XXX }
  330. {#F-}
  331. { where XXX are the current values of the corresponding variables. }
  332. procedure GetData (var Rec); virtual;
  333. { GetData assumes Rec is a #TGaugeRec# and returns the current settings
  334. of the gauge. }
  335. {#X SetData }
  336. procedure Reset; virtual;
  337. { Reset sets #Current# to #Min# then redraws the status view. }
  338. {#X TStatus.Reset }
  339. procedure SetData (var Rec); virtual;
  340. { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
  341. accordingly. }
  342. {#X GetData }
  343. procedure Store (var S : TStream); { store should never be virtual;}
  344. { Store calls the inherited Store method then writes #Min#, #Max# and
  345. #Current# to the stream. }
  346. {#X Load }
  347. procedure Update (Data : Pointer); virtual;
  348. { Update increments #Current#. }
  349. end; { of TGauge }
  350. {#Z+}
  351. PGaugeRec = ^TGaugeRec;
  352. {#Z-}
  353. TGaugeRec = record
  354. { A TGaugeRec is used to set and get a #TGauge#'s variables. }
  355. {#X TGauge.GetData TGauge.SetData }
  356. Min, Max, Current : LongInt;
  357. end; { of TGaugeRec }
  358. {#Z+}
  359. PArrowGauge = ^TArrowGauge;
  360. {#Z-}
  361. TArrowGauge = Object(TGauge)
  362. { An arrow gauge draws a progressively larger series of arrows across the
  363. view. If Right is True, the arrows are right facing, '>', and are
  364. drawn from left to right. If Right is False, the arrows are left
  365. facing, '<', and are drawn from right to left. }
  366. Right : Boolean;
  367. { Right determines the direction of arrow used and the direction which
  368. the status view is filled. If Right is True, the arrows are right
  369. facing, '>', and are drawn from left to right. If Right is False,
  370. the arrows are left facing, '<', and are drawn from right to left. }
  371. {#X Draw }
  372. constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
  373. RightArrow : Boolean);
  374. { Init calls the inherited constructor then sets #Right# to RightArrow.
  375. If an error occurs Init fails. }
  376. {#X Load }
  377. constructor Load (var S : TStream);
  378. { Load calls the inherited constructor then reads #Right# from the
  379. stream.
  380. If an error occurs Load fails. }
  381. {#X Init Store }
  382. procedure Draw; virtual;
  383. { Draw fills the Current / Max percent of the view with arrows. }
  384. {#X Right }
  385. procedure GetData (var Rec); virtual;
  386. { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
  387. settings of the views variables. }
  388. {#X SetData }
  389. procedure SetData (var Rec); virtual;
  390. { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
  391. variables accordingly. }
  392. {#X GetData }
  393. procedure Store (var S : TStream); { store should never be virtual;}
  394. { Store calls the inherited Store method then writes #Right# to the
  395. stream. }
  396. {#X Load }
  397. end; { of TArrowGauge }
  398. {#Z+}
  399. PArrowGaugeRec = ^TArrowGaugeRec;
  400. {#Z-}
  401. TArrowGaugeRec = record
  402. { A TArrowGaugeRec is used to set and get the variables of a
  403. #TArrowGauge#. }
  404. {#X TArrowGauge.GetData TArrowGauge.SetData }
  405. Min, Max, Count : LongInt;
  406. Right : Boolean;
  407. end; { of TGaugeRec }
  408. {#Z+}
  409. PPercentGauge = ^TPercentGauge;
  410. {#Z-}
  411. TPercentGauge = Object(TGauge)
  412. { A TPercentGauge displays a numerical percentage as returned by
  413. #Percent# followed by a '%' sign. }
  414. function Percent : Integer; virtual;
  415. { Percent returns the whole number value of (Current / Max) * 100. }
  416. {#X TGauge.Current TGauge.Max }
  417. procedure Draw; virtual;
  418. { Draw writes the current percentage to the screen. }
  419. {#X Percent }
  420. end; { of TPercentGauge }
  421. {#Z+}
  422. PBarGauge = ^TBarGauge;
  423. {#Z-}
  424. TBarGauge = Object(TPercentGauge)
  425. { A TBarGauge displays a bar which increases in size from the left to
  426. the right of the view as Current increases. A numeric percentage
  427. representing the value of (Current / Max) * 100 is displayed in the
  428. center of the bar. }
  429. {#x TPercentGauge.Percent }
  430. procedure Draw; virtual;
  431. { Draw draws the bar and percentage to the screen representing the
  432. current status of the view's variables. }
  433. {#X TGauge.Update }
  434. function GetPalette : PPalette; virtual;
  435. { GetPalette returns a pointer to the default status view palette,
  436. #CBarStatus#. }
  437. end; { of TBarGauge }
  438. {#Z+}
  439. PSpinnerGauge = ^TSpinnerGauge;
  440. {#Z-}
  441. TSpinnerGauge = Object(TGauge)
  442. { A TSpinnerGauge displays a series of characters in one spot on the
  443. screen giving the illusion of a spinning line. }
  444. constructor Init (X, Y : Integer; ACommand : Word);
  445. { Init calls the inherited constructor with AMin set to 0 and AMax set
  446. to 4. }
  447. procedure Draw; virtual;
  448. { Draw uses the #SpinChars# variable to draw the view's Current
  449. character. }
  450. {#X Update }
  451. procedure HandleEvent (var Event : TEvent); virtual;
  452. { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
  453. is not generated when Current equals Max. }
  454. {#X TGauge.Current TGauge.Max }
  455. procedure Update (Data : Pointer); virtual;
  456. { Update increments Current until Current equals Max, when it resets
  457. Current to Min. }
  458. {#X Draw HandleEvent }
  459. end; { of TSpinnerGauge }
  460. {#Z+}
  461. PAppStatus = ^TAppStatus;
  462. {#Z-}
  463. TAppStatus = Object(TStatus)
  464. { TAppStatus is a base object which implements color control for status
  465. views that are normally inserted in the Application object. }
  466. {#X TStatus }
  467. function GetPalette : PPalette; virtual;
  468. { GetPalette returns a pointer to the default application status view
  469. palette, #CAppStatus#. }
  470. {#X TStatus CStatus }
  471. end; { of TAppStatus }
  472. {#Z+}
  473. PHeapMaxAvail = ^THeapMaxAvail;
  474. {#Z-}
  475. THeapMaxAvail = Object(TAppStatus)
  476. { A THeapMaxAvail displays the largest available contiguous area of heap
  477. memory. It responds to a cmStatusUpdate event by calling MaxAvail and
  478. comparing the result to #Max#, then updating the view if necessary. }
  479. {#X THeapMemAvail }
  480. constructor Init (X, Y : Integer);
  481. { Init creates the view with the following text:
  482. MaxAvail = xxxx
  483. where xxxx is the result returned by MaxAvail. }
  484. procedure Update (Data : Pointer); virtual;
  485. { Update changes #Mem# to the current MemAvail and redraws the status
  486. if necessary. }
  487. private
  488. Max : LongInt;
  489. { Max is the last reported value from MaxAvail. }
  490. {#X Update }
  491. end; { of THeapMaxAvail }
  492. {#Z+}
  493. PHeapMemAvail = ^THeapMemAvail;
  494. {#Z-}
  495. THeapMemAvail = Object(TAppStatus)
  496. { A THeapMemAvail displays the total amount of heap memory available to
  497. the application. It responds to a cmStatusUpdate event by calling
  498. MemAvail and comparing the result to #Max#, then updating the view if
  499. necessary. }
  500. {#X THeapMaxAvail }
  501. constructor Init (X, Y : Integer);
  502. { Init creates the view with the following text:
  503. MemAvail = xxxx
  504. where xxxx is the result returned by MemAvail. }
  505. {#X Load }
  506. procedure Update (Data : Pointer); virtual;
  507. { Update changes #Mem# to the current MemAvail and redraws the status
  508. if necessary. }
  509. private
  510. Mem : LongInt;
  511. { Mem is the last available value reported by MemAvail. }
  512. {#X Update }
  513. end; { of THeapMemAvail }
  514. {$ifndef cdPrintDoc}
  515. {#Z+}
  516. {$endif cdPrintDoc}
  517. const
  518. RStatus : TStreamRec = (
  519. ObjType : idStatus;
  520. VmtLink : Ofs(TypeOf(TStatus)^);
  521. Load : @TStatus.Load;
  522. Store : @TStatus.Store);
  523. RStatusDlg : TStreamRec = (
  524. ObjType : idStatusDlg;
  525. VmtLink : Ofs(TypeOf(TStatusDlg)^);
  526. Load : @TStatusDlg.Load;
  527. Store : @TStatusDlg.Store);
  528. RStatusMessageDlg : TStreamRec = (
  529. ObjType : idStatusMessageDlg;
  530. VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
  531. Load : @TStatusMessageDlg.Load;
  532. Store : @TStatusMessageDlg.Store);
  533. RGauge : TStreamRec = (
  534. ObjType : idGauge;
  535. VmtLink : Ofs(TypeOf(TGauge)^);
  536. Load : @TGauge.Load;
  537. Store : @TGauge.Store);
  538. RArrowGauge : TStreamRec = (
  539. ObjType : idArrowGauge;
  540. VmtLink : Ofs(TypeOf(TArrowGauge)^);
  541. Load : @TArrowGauge.Load;
  542. Store : @TArrowGauge.Store);
  543. RBarGauge : TStreamRec = (
  544. ObjType : idBarGauge;
  545. VmtLink : Ofs(TypeOf(TBarGauge)^);
  546. Load : @TBarGauge.Load;
  547. Store : @TBarGauge.Store);
  548. RPercentGauge : TStreamRec = (
  549. ObjType : idPercentGauge;
  550. VmtLink : Ofs(TypeOf(TPercentGauge)^);
  551. Load : @TPercentGauge.Load;
  552. Store : @TPercentGauge.Store);
  553. RSpinnerGauge : TStreamRec = (
  554. ObjType : idSpinnerGauge;
  555. VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
  556. Load : @TSpinnerGauge.Load;
  557. Store : @TSpinnerGauge.Store);
  558. RAppStatus : TStreamRec = (
  559. ObjType : idAppStatus;
  560. VmtLink : Ofs(TypeOf(TAppStatus)^);
  561. Load : @TAppStatus.Load;
  562. Store : @TAppStatus.Store);
  563. RHeapMinAvail : TStreamRec = (
  564. ObjType : idHeapMinAvail;
  565. VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
  566. Load : @THeapMaxAvail.Load;
  567. Store : @THeapMaxAvail.Store);
  568. RHeapMemAvail : TStreamRec = (
  569. ObjType : idHeapMemAvail;
  570. VmtLink : Ofs(TypeOf(THeapMemAvail)^);
  571. Load : @THeapMemAvail.Load;
  572. Store : @THeapMemAvail.Store);
  573. {$ifndef cdPrintDoc}
  574. {#Z-}
  575. {$endif cdPrintDoc}
  576. procedure RegisterStatuses;
  577. {$ifndef cdPrintDoc}
  578. {#F+}
  579. {ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
  580. ÝRegisterStatuses procedure (Statuses unit)Þ
  581. ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
  582. {#F-}
  583. {$endif cdPrintDoc}
  584. { RegisterStatuses calls RegisterType for each of the status view and
  585. status dialog object types defined in the tvStatus unit. After calling
  586. RegisterStatuses, your application can read or write any of those types
  587. with streams. }
  588. implementation
  589. uses
  590. MsgBox, App;
  591. {****************************************************************************}
  592. { Local procedures and functions }
  593. {****************************************************************************}
  594. {****************************************************************************}
  595. { TAppStatus Object }
  596. {****************************************************************************}
  597. {****************************************************************************}
  598. { TAppStatus.GetPalette }
  599. {****************************************************************************}
  600. function TAppStatus.GetPalette : PPalette;
  601. const P : String[Length(CAppStatus)] = CAppStatus;
  602. begin
  603. GetPalette := PPalette(@P);
  604. end;
  605. {****************************************************************************}
  606. { TArrowGauge Object }
  607. {****************************************************************************}
  608. {****************************************************************************}
  609. { TArrowGauge.Init }
  610. {****************************************************************************}
  611. constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
  612. RightArrow : Boolean);
  613. begin
  614. if not TGauge.Init(R,ACommand,AMin,AMax) then
  615. Fail;
  616. Right := RightArrow;
  617. end;
  618. {****************************************************************************}
  619. { TArrowGauge.Load }
  620. {****************************************************************************}
  621. constructor TArrowGauge.Load (var S : TStream);
  622. begin
  623. if not TGauge.Load(S) then
  624. Fail;
  625. S.Read(Right,SizeOf(Right));
  626. if (S.Status <> stOk) then
  627. begin
  628. TGauge.Done;
  629. Fail;
  630. end;
  631. end;
  632. {****************************************************************************}
  633. { TArrowGauge.Draw }
  634. {****************************************************************************}
  635. procedure TArrowGauge.Draw;
  636. const Arrows : array[0..1] of Char = '<>';
  637. var
  638. B : TDrawBuffer;
  639. C : Word;
  640. Len : Byte;
  641. begin
  642. C := GetColor(1);
  643. Len := Round(Size.X * Current/(Max - Min));
  644. MoveChar(B,' ',C,Size.X);
  645. if Right then
  646. MoveChar(B,Arrows[Byte(Right)],C,Len)
  647. else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
  648. WriteLine(0,0,Size.X,1,B);
  649. end;
  650. {****************************************************************************}
  651. { TArrowGauge.GetData }
  652. {****************************************************************************}
  653. procedure TArrowGauge.GetData (var Rec);
  654. begin
  655. PArrowGaugeRec(Rec)^.Min := Min;
  656. PArrowGaugeRec(Rec)^.Max := Max;
  657. PArrowGaugeRec(Rec)^.Count := Current;
  658. PArrowGaugeRec(Rec)^.Right := Right;
  659. end;
  660. {****************************************************************************}
  661. { TArrowGauge.SetData }
  662. {****************************************************************************}
  663. procedure TArrowGauge.SetData (var Rec);
  664. begin
  665. Min := PArrowGaugeRec(Rec)^.Min;
  666. Max := PArrowGaugeRec(Rec)^.Max;
  667. Current := PArrowGaugeRec(Rec)^.Count;
  668. Right := PArrowGaugeRec(Rec)^.Right;
  669. end;
  670. {****************************************************************************}
  671. { TArrowGauge.Store }
  672. {****************************************************************************}
  673. procedure TArrowGauge.Store (var S : TStream);
  674. begin
  675. TGauge.Store(S);
  676. S.Write(Right,SizeOf(Right));
  677. end;
  678. {****************************************************************************}
  679. { TBarGauge Object }
  680. {****************************************************************************}
  681. {****************************************************************************}
  682. { TBarGauge.Draw }
  683. {****************************************************************************}
  684. procedure TBarGauge.Draw;
  685. var
  686. B : TDrawBuffer;
  687. C : Word;
  688. FillSize : Word;
  689. PercentDone : LongInt;
  690. S : String[4];
  691. begin
  692. { fill entire view }
  693. MoveChar(B,' ',GetColor(4),Size.X);
  694. { make progress bar }
  695. C := GetColor(5);
  696. FillSize := Round(Size.X * (Current / Max));
  697. MoveChar(B,' ',C,FillSize);
  698. { display percent done }
  699. PercentDone := Percent;
  700. FormatStr(S,'%d%%',PercentDone);
  701. if PercentDone < 50 then
  702. C := GetColor(4);
  703. FillSize := (Size.X - Length(S)) div 2;
  704. MoveStr(B[FillSize],S,C);
  705. WriteLine(0,0,Size.X,Size.Y,B);
  706. end;
  707. {****************************************************************************}
  708. { TBarGauge.GetPalette }
  709. {****************************************************************************}
  710. function TBarGauge.GetPalette : PPalette;
  711. const
  712. S : String[Length(CBarGauge)] = CBarGauge;
  713. begin
  714. GetPalette := PPalette(@S);
  715. end;
  716. {****************************************************************************}
  717. { TGauge Object }
  718. {****************************************************************************}
  719. {****************************************************************************}
  720. { TGauge.Init }
  721. {****************************************************************************}
  722. constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
  723. begin
  724. if not TStatus.Init(R,ACommand,'',1) then
  725. Fail;
  726. Min := AMin;
  727. Max := AMax;
  728. Current := Min;
  729. end;
  730. {****************************************************************************}
  731. { TGauge.Load }
  732. {****************************************************************************}
  733. constructor TGauge.Load (var S : TStream);
  734. begin
  735. if not TStatus.Load(S) then
  736. Fail;
  737. S.Read(Min,SizeOf(Min));
  738. S.Read(Max,SizeOf(Max));
  739. S.Read(Current,SizeOf(Current));
  740. if S.Status <> stOk then
  741. begin
  742. TStatus.Done;
  743. Fail;
  744. end;
  745. end;
  746. {****************************************************************************}
  747. { TGauge.Draw }
  748. {****************************************************************************}
  749. procedure TGauge.Draw;
  750. var
  751. S : String;
  752. B : TDrawBuffer;
  753. begin
  754. { Blank the gauge }
  755. MoveChar(B,' ',GetColor(1),Size.X);
  756. WriteBuf(0,0,Size.X,Size.Y,B);
  757. { write current status }
  758. FormatStr(S,'%d',Current);
  759. MoveStr(B,S,GetColor(1));
  760. WriteBuf(0,0,Size.X,Size.Y,B);
  761. end;
  762. {****************************************************************************}
  763. { TGauge.GetData }
  764. {****************************************************************************}
  765. procedure TGauge.GetData (var Rec);
  766. begin
  767. TGaugeRec(Rec).Min := Min;
  768. TGaugeRec(Rec).Max := Max;
  769. TGaugeRec(Rec).Current := Current;
  770. end;
  771. {****************************************************************************}
  772. { TGauge.Reset }
  773. {****************************************************************************}
  774. procedure TGauge.Reset;
  775. begin
  776. Current := Min;
  777. DrawView;
  778. end;
  779. {****************************************************************************}
  780. { TGauge.SetData }
  781. {****************************************************************************}
  782. procedure TGauge.SetData (var Rec);
  783. begin
  784. Min := TGaugeRec(Rec).Min;
  785. Max := TGaugeRec(Rec).Max;
  786. Current := TGaugeRec(Rec).Current;
  787. end;
  788. {****************************************************************************}
  789. { TGauge.Store }
  790. {****************************************************************************}
  791. procedure TGauge.Store (var S : TStream);
  792. begin
  793. TStatus.Store(S);
  794. S.Write(Min,SizeOf(Min));
  795. S.Write(Max,SizeOf(Max));
  796. S.Write(Current,SizeOf(Current));
  797. end;
  798. {****************************************************************************}
  799. { TGauge.Update }
  800. {****************************************************************************}
  801. procedure TGauge.Update (Data : Pointer);
  802. begin
  803. if Current < Max then
  804. begin
  805. Inc(Current);
  806. DrawView;
  807. end
  808. else Message(@Self,evStatus,cmStatusDone,@Self);
  809. end;
  810. {****************************************************************************}
  811. { THeapMaxAvail Object }
  812. {****************************************************************************}
  813. {****************************************************************************}
  814. { THeapMaxAvail.Init }
  815. {****************************************************************************}
  816. constructor THeapMaxAvail.Init (X, Y : Integer);
  817. var
  818. R : TRect;
  819. begin
  820. R.Assign(X,Y,X+20,Y+1);
  821. if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
  822. Fail;
  823. Max := -1;
  824. end;
  825. {****************************************************************************}
  826. { THeapMaxAvail.Update }
  827. {****************************************************************************}
  828. procedure THeapMaxAvail.Update (Data : Pointer);
  829. var
  830. M : LongInt;
  831. begin
  832. M := MaxAvail;
  833. if (Max <> M) then
  834. begin
  835. Max := MaxAvail;
  836. SetData(Max);
  837. end;
  838. end;
  839. {****************************************************************************}
  840. { THeapMemAvail Object }
  841. {****************************************************************************}
  842. {****************************************************************************}
  843. { THeapMemAvail.Init }
  844. {****************************************************************************}
  845. constructor THeapMemAvail.Init (X, Y : Integer);
  846. var
  847. R : TRect;
  848. begin
  849. R.Assign(X,Y,X+20,Y+1);
  850. if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
  851. Fail;
  852. Mem := -1;
  853. end;
  854. {****************************************************************************}
  855. { THeapMemAvail.Update }
  856. {****************************************************************************}
  857. procedure THeapMemAvail.Update (Data : Pointer);
  858. { Total bytes available on the heap. May not be contiguous. }
  859. var
  860. M : LongInt;
  861. begin
  862. M := MemAvail;
  863. if (Mem <> M) then
  864. begin
  865. Mem := M;
  866. SetData(Mem);
  867. end;
  868. end;
  869. {****************************************************************************}
  870. { TPercentGauge Object }
  871. {****************************************************************************}
  872. {****************************************************************************}
  873. { TPercentGauge.Draw }
  874. {****************************************************************************}
  875. procedure TPercentGauge.Draw;
  876. var
  877. B : TDrawBuffer;
  878. C : Word;
  879. S : String;
  880. PercentDone : LongInt;
  881. FillSize : Integer;
  882. begin
  883. C := GetColor(1);
  884. MoveChar(B,' ',C,Size.X);
  885. WriteLine(0,0,Size.X,Size.Y,B);
  886. PercentDone := Percent;
  887. FormatStr(S,'%d%%',PercentDone);
  888. MoveStr(B[(Size.X - Byte(S[0])) div 2],S,C);
  889. WriteLine(0,0,Size.X,Size.Y,B);
  890. end;
  891. {****************************************************************************}
  892. { TPercentGauge.Percent }
  893. {****************************************************************************}
  894. function TPercentGauge.Percent : Integer;
  895. { Returns percent as a whole integer Current of Max }
  896. begin
  897. Percent := Round((Current/Max) * 100);
  898. end;
  899. {****************************************************************************}
  900. { TSpinnerGauge Object }
  901. {****************************************************************************}
  902. {****************************************************************************}
  903. { TSpinnerGauge.Init }
  904. {****************************************************************************}
  905. constructor TSpinnerGauge.Init (X, Y : Integer; ACommand : Word);
  906. var R : TRect;
  907. begin
  908. R.Assign(X,Y,X+1,Y+1);
  909. if not TGauge.Init(R,ACommand,1,4) then
  910. Fail;
  911. end;
  912. {****************************************************************************}
  913. { TSpinnerGauge.Draw }
  914. {****************************************************************************}
  915. procedure TSpinnerGauge.Draw;
  916. var
  917. B : TDrawBuffer;
  918. C : Word;
  919. begin
  920. C := GetColor(1);
  921. MoveChar(B,' ',C,Size.X);
  922. WriteLine(0,0,Size.X,Size.Y,B);
  923. MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
  924. WriteLine(0,0,Size.X,Size.Y,B);
  925. end;
  926. {****************************************************************************}
  927. { TSpinnerGauge.HandleEvent }
  928. {****************************************************************************}
  929. procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
  930. begin
  931. TStatus.HandleEvent(Event);
  932. end;
  933. {****************************************************************************}
  934. { TSpinnerGauge.Update }
  935. {****************************************************************************}
  936. procedure TSpinnerGauge.Update (Data : Pointer);
  937. begin
  938. if Current = Max then
  939. Current := Min
  940. else Inc(Current);
  941. DrawView;
  942. end;
  943. {****************************************************************************}
  944. { TStatus Object }
  945. {****************************************************************************}
  946. {****************************************************************************}
  947. { TStatus.Init }
  948. {****************************************************************************}
  949. constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
  950. AParamCount : Integer);
  951. begin
  952. if (not TParamText.Init(R,AText,AParamCount)) then
  953. Fail;
  954. EventMask := EventMask or evStatus;
  955. Command := ACommand;
  956. end;
  957. {****************************************************************************}
  958. { TStatus.Load }
  959. {****************************************************************************}
  960. constructor TStatus.Load (var S : TStream);
  961. begin
  962. if not TParamText.Load(S) then
  963. Fail;
  964. S.Read(Command,SizeOf(Command));
  965. if (S.Status <> stOk) then
  966. begin
  967. TParamText.Done;
  968. Fail;
  969. end;
  970. end;
  971. {****************************************************************************}
  972. { TStatus.Cancel }
  973. {****************************************************************************}
  974. function TStatus.Cancel : Boolean;
  975. begin
  976. Cancel := True;
  977. end;
  978. {****************************************************************************}
  979. { TStatus.GetPalette }
  980. {****************************************************************************}
  981. function TStatus.GetPalette : PPalette;
  982. const
  983. P : String[Length(CStatus)] = CStatus;
  984. begin
  985. GetPalette := PPalette(@P);
  986. end;
  987. {****************************************************************************}
  988. { TStatus.HandleEvent }
  989. {****************************************************************************}
  990. procedure TStatus.HandleEvent (var Event : TEvent);
  991. begin
  992. if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
  993. begin
  994. Pause;
  995. ClearEvent(Event);
  996. end;
  997. case Event.What of
  998. evStatus :
  999. case Event.Command of
  1000. cmStatusDone :
  1001. if (Event.InfoPtr = @Self) then
  1002. begin
  1003. Message(Owner,evStatus,cmStatusDone,@Self);
  1004. ClearEvent(Event);
  1005. end;
  1006. cmStatusUpdate :
  1007. if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
  1008. begin
  1009. Update(Event.InfoPtr);
  1010. { ClearEvent(Event); } { don't clear the event so multiple }
  1011. { status views can respond to the same event }
  1012. end;
  1013. cmStatusResume :
  1014. if (Event.InfoWord = Command) and
  1015. ((State and sfPause) = sfPause) then
  1016. begin
  1017. Resume;
  1018. ClearEvent(Event);
  1019. end;
  1020. cmStatusPause :
  1021. if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
  1022. begin
  1023. Pause;
  1024. ClearEvent(Event);
  1025. end;
  1026. end;
  1027. end;
  1028. TParamText.HandleEvent(Event);
  1029. end;
  1030. {****************************************************************************}
  1031. { TStatus.Pause }
  1032. {****************************************************************************}
  1033. procedure TStatus.Pause;
  1034. begin
  1035. SetState(sfPause,True);
  1036. end;
  1037. {****************************************************************************}
  1038. { TStatus.Reset }
  1039. {****************************************************************************}
  1040. procedure TStatus.Reset;
  1041. begin
  1042. DrawView;
  1043. end;
  1044. {****************************************************************************}
  1045. { TStatus.Resume }
  1046. {****************************************************************************}
  1047. procedure TStatus.Resume;
  1048. begin
  1049. SetState(sfPause,False);
  1050. end;
  1051. {****************************************************************************}
  1052. { TStatus.Store }
  1053. {****************************************************************************}
  1054. procedure TStatus.Store (var S : TStream);
  1055. begin
  1056. TParamText.Store(S);
  1057. S.Write(Command,SizeOf(Command));
  1058. end;
  1059. {****************************************************************************}
  1060. { TStatus.Update }
  1061. {****************************************************************************}
  1062. procedure TStatus.Update (Data : Pointer);
  1063. begin
  1064. DisposeStr(Text);
  1065. Text := NewStr(String(Data^));
  1066. DrawView;
  1067. end;
  1068. {****************************************************************************}
  1069. { TStatusDlg Object }
  1070. {****************************************************************************}
  1071. {****************************************************************************}
  1072. { TStatusDlg.Init }
  1073. {****************************************************************************}
  1074. constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
  1075. AFlags : Word);
  1076. var
  1077. R : TRect;
  1078. i : LongInt;
  1079. Buttons : Byte;
  1080. begin
  1081. if (AStatus = nil) then
  1082. Fail;
  1083. R.A := AStatus^.Origin;
  1084. R.B := AStatus^.Size;
  1085. Inc(R.B.Y,R.A.Y+4);
  1086. Inc(R.B.X,R.A.X+5);
  1087. if not TDialog.Init(R,ATitle) then
  1088. Fail;
  1089. EventMask := EventMask or evStatus;
  1090. Status := AStatus;
  1091. Status^.MoveTo(2,2);
  1092. Insert(Status);
  1093. InsertButtons(AFlags);
  1094. end;
  1095. {****************************************************************************}
  1096. { TStatusDlg.Load }
  1097. {****************************************************************************}
  1098. constructor TStatusDlg.Load (var S : TStream);
  1099. begin
  1100. if not TDialog.Load(S) then
  1101. Fail;
  1102. GetSubViewPtr(S,Status);
  1103. if (S.Status <> stOk) then
  1104. begin
  1105. if (Status <> nil) then
  1106. Dispose(Status,Done);
  1107. TDialog.Done;
  1108. Fail;
  1109. end;
  1110. end;
  1111. {****************************************************************************}
  1112. { TStatusDlg.Cancel }
  1113. {****************************************************************************}
  1114. procedure TStatusDlg.Cancel (ACommand : Word);
  1115. begin
  1116. if Status^.Cancel then
  1117. TDialog.Cancel(ACommand);
  1118. end;
  1119. {****************************************************************************}
  1120. { TStatusDlg.HandleEvent }
  1121. {****************************************************************************}
  1122. procedure TStatusDlg.HandleEvent (var Event : TEvent);
  1123. begin
  1124. case Event.What of
  1125. evStatus :
  1126. case Event.Command of
  1127. cmStatusDone :
  1128. if Event.InfoPtr = Status then
  1129. begin
  1130. TDialog.Cancel(cmOk);
  1131. ClearEvent(Event);
  1132. end;
  1133. end;
  1134. { else let TDialog.HandleEvent send to all subviews for handling }
  1135. evBroadcast, evCommand :
  1136. case Event.Command of
  1137. cmCancel, cmClose :
  1138. begin
  1139. Cancel(cmCancel);
  1140. ClearEvent(Event);
  1141. end;
  1142. cmStatusPause :
  1143. begin
  1144. Status^.Pause;
  1145. ClearEvent(Event);
  1146. end;
  1147. cmStatusResume :
  1148. begin
  1149. Status^.Resume;
  1150. ClearEvent(Event);
  1151. end;
  1152. end;
  1153. end;
  1154. TDialog.HandleEvent(Event);
  1155. end;
  1156. {****************************************************************************}
  1157. { TStatusDlg.InsertButtons }
  1158. {****************************************************************************}
  1159. procedure TStatusDlg.InsertButtons (AFlags : Word);
  1160. var
  1161. R : TRect;
  1162. P : PButton;
  1163. Buttons : Byte;
  1164. X, Y, Gap : Integer;
  1165. i : Word;
  1166. begin
  1167. Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
  1168. { do this Inc twice, once for Pause and once for Resume buttons }
  1169. Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
  1170. if Buttons > 0 then
  1171. begin
  1172. Status^.GrowMode := gfGrowHiX;
  1173. { resize dialog to hold all requested buttons }
  1174. if Size.X < ((Buttons * 12) + 2) then
  1175. GrowTo((Buttons * 12) + 2,Size.Y + 2)
  1176. else GrowTo(Size.X,Size.Y + 2);
  1177. { find correct starting position for first button }
  1178. Gap := Size.X - (Buttons * 10) - 2;
  1179. Gap := Gap div Succ(Buttons);
  1180. X := Gap;
  1181. if X < 2 then
  1182. X := 2;
  1183. Y := Size.Y - 3;
  1184. { insert buttons }
  1185. if ((AFlags and sdCancelButton) = sdCancelButton) then
  1186. begin
  1187. P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
  1188. P^.GrowMode := gfGrowHiY or gfGrowLoY;
  1189. Inc(X,12 + Gap);
  1190. end;
  1191. if ((AFlags and sdPauseButton) = sdPauseButton) then
  1192. begin
  1193. P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
  1194. P^.GrowMode := gfGrowHiY or gfGrowLoY;
  1195. Inc(X,12 + Gap);
  1196. P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
  1197. bfBroadcast);
  1198. P^.GrowMode := gfGrowHiY or gfGrowLoY;
  1199. end;
  1200. end; { of if }
  1201. SelectNext(False);
  1202. end;
  1203. {****************************************************************************}
  1204. { TStatusDlg.Store }
  1205. {****************************************************************************}
  1206. procedure TStatusDlg.Store (var S : TStream);
  1207. begin
  1208. TDialog.Store(S);
  1209. PutSubViewPtr(S,Status);
  1210. end;
  1211. {****************************************************************************}
  1212. { TStatusMessageDlg Object }
  1213. {****************************************************************************}
  1214. {****************************************************************************}
  1215. { TStatusMessageDlg.Init }
  1216. {****************************************************************************}
  1217. constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
  1218. AFlags : Word; AMessage : String);
  1219. var
  1220. P : PStaticText;
  1221. X, Y : Integer;
  1222. R : TRect;
  1223. begin
  1224. if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
  1225. Fail;
  1226. Status^.GrowMode := gfGrowLoY or gfGrowHiY;
  1227. GetExtent(R);
  1228. X := R.B.X - R.A.X;
  1229. if X < Size.X then
  1230. X := Size.X;
  1231. Y := R.B.Y - R.A.Y;
  1232. if Y < Size.Y then
  1233. Y := Size.Y;
  1234. GrowTo(X,Y);
  1235. R.Assign(2,2,Size.X-2,Size.Y-3);
  1236. P := New(PStaticText,Init(R,AMessage));
  1237. if (P = nil) then
  1238. begin
  1239. TStatusDlg.Done;
  1240. Fail;
  1241. end;
  1242. GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
  1243. Insert(P);
  1244. end;
  1245. {****************************************************************************}
  1246. { Global procedures and functions }
  1247. {****************************************************************************}
  1248. {****************************************************************************}
  1249. { RegisterStatuses }
  1250. {****************************************************************************}
  1251. procedure RegisterStatuses;
  1252. begin
  1253. { RegisterType(RStatus);
  1254. RegisterType(RStatusDlg);
  1255. RegisterType(RGauge);
  1256. RegisterType(RArrowGauge);
  1257. RegisterType(RPercentGauge);
  1258. RegisterType(RBarGauge);
  1259. RegisterType(RSpinnerGauge); }
  1260. end;
  1261. {****************************************************************************}
  1262. { Unit Initialization }
  1263. {****************************************************************************}
  1264. begin
  1265. end.