/packages/fv/src/statuses.pas

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