summaryrefslogtreecommitdiff
path: root/packages/fv/src/statuses.pas
diff options
context:
space:
mode:
Diffstat (limited to 'packages/fv/src/statuses.pas')
-rw-r--r--packages/fv/src/statuses.pas1404
1 files changed, 1404 insertions, 0 deletions
diff --git a/packages/fv/src/statuses.pas b/packages/fv/src/statuses.pas
new file mode 100644
index 0000000000..143848ba25
--- /dev/null
+++ b/packages/fv/src/statuses.pas
@@ -0,0 +1,1404 @@
+{$V-}
+unit Statuses;
+
+{$CODEPAGE cp437}
+
+{#Z+}
+{ Free Vision Status Objects Unit
+ Free VIsion
+ Written by : Brad Williams, DVM
+
+Revision History
+
+1.2.3 (96/04/13)
+ - moved Pause and Resume to methods of TStatus leaving TStatus Pause and
+ Resume "aware"
+ - eliminated many bugs
+ - moved Pause, Resume and Cancel from TStatusDlg to TStatus
+
+1.2.1 (95/12/6)
+ - minor typo corrections in opening unit documentation
+ - F+ to Z+ around stream registration records
+ - removed redundant sentence in TAppStatus definition
+ - updated CBarStatus documentation and constant
+ - removed TGauge.Init cross-reference from TSpinner.Init
+ - added THeapMemAvail and RegistertvStatus documentation
+ - numerous other documentation updates
+ - changed all calls to Send to Message
+
+1.2.0 (95/11/24)
+ - conversion to Bsd format
+
+1.1.0 (05/01/94)
+ - initial WVS release
+
+
+Known Bugs
+
+ScanHelp Errors
+ - sdXXXX constants help documentation doesn't show TStatusDlg and
+ TMessageStatusDlg
+ - ScanHelp produces garbage in evStatus help context
+
+tvStatus Bugs
+ - CAppStatus may not be correct }
+{#Z-}
+
+{ The tvStatus unit implements several views for providing information to
+the user which needs to be updated during program execution, such as a
+progress indicator, clock, heap viewer, gauges, etc. All tvStatus views
+respond to a new message event class, evStatus. An individual status view
+only processes an event with its associated command. }
+
+interface
+
+{$i platform.inc}
+
+{$ifdef PPC_FPC}
+ {$H-}
+{$else}
+ {$F+,O+,E+,N+}
+{$endif}
+{$X+,R-,I-,Q-,V-}
+{$ifndef OS_UNIX}
+ {$S-}
+{$endif}
+
+uses
+
+ FVCommon, FVConsts, Objects, Drivers, Views, Dialogs;
+{ Resource;}
+
+const
+
+ evStatus = $8000;
+ { evStatus represents the event class all status views know how to
+ respond to. }
+ {#X Statuses }
+
+
+ CStatus = #1#2#3;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTStatus.CStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views use the default palette, CStatus, to map onto the first three
+entries in the standard window palette. }
+{#F+}
+{ 1 2 3
+ ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CStatus º 1 ³ 2 ³ 3 º
+ ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÙ ³ ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
+Highlighted TextÄÄÄÄÄÄÄÄÙ }
+{#F-}
+{#X TStatus }
+
+ CAppStatus = #2#5#4;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTAppStatus.CAppStatus palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ Status views which are inserted into the application rather than a dialog
+or window use the default palette, CAppStatus, to map onto the application
+object's palette. }
+{#F+}
+{ 1 2 3
+ ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus º 2 ³ 5 ³ 4 º
+ ÈÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ ³ ³
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+ {#X tvStatus TAppStatus }
+
+
+ CBarGauge = CStatus + #16#19;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÝTBarGauge.CBarGauge palette
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+{ TBarGauge's use the default palette, CBarGauge, to map onto the dialog or
+window owner's palette. }
+{#F+}
+{ 1 2 3 4 5
+ ÉÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍÑÍÍÍÍ»
+ CAppStatus º 2 ³ 5 ³ 4 ³ 16 ³ 19 º
+ ÈÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑÍÏÍÍÑͼ
+Normal TextÄÄÄÄÄÄÙ ³ ³ ³ ÀÄÄÄÄ filled in bar
+OtherÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³ ÀÄÄÄÄÄÄÄÄÄ empty bar
+Highlighted TextÄÄÄÄÄÄÄÄÄÄÄÙ }
+{#F-}
+ {#X tvStatus TBarGauge }
+
+
+{#T sdXXXX }
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+Ý sdXXXX constants (STDDLG unit) Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdNoPrintDoc}
+{ sdXXXX constants are used to determine the types of buttons displayed in a
+#TStatusDlg# or #TStatusMessageDlg#. }
+{#F+}
+{ Constant ³ Value ³ Meaning
+ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
+ sdNone ³ $0000 ³ no buttons
+ sdCancelButton ³ $0001 ³ show Cancel button
+ sdPauseButton ³ $0002 ³ show Pause button
+ sdResumeButton ³ $0004 ³ show Resume button
+ sdAllButtons ³ $0008 ³ show Cancel, Pause and Resume
+ ³ ³ buttons }
+{#Z+}
+ sdNone = $0000;
+ sdCancelButton = $0001;
+ sdPauseButton = $0002;
+ sdResumeButton = $0004;
+ sdAllButtons = sdCancelButton or sdPauseButton or sdResumeButton;
+{#Z-}
+ {#X tvStatus TStatusDlg TStatusMessageDlg }
+
+ SpinChars : String[4] = '³/Ä\';
+ { SpinChars are the characters used by a #TSpinnerGauge# when it is drawn.
+ Only one character is displayed at a time. The string is cycled
+ through then started over again until the view is disposed. }
+ {#X tvStatus }
+
+ sfPause = $F000;
+ { sfPause is an additional state flag used internally by status views to
+ indicate they are in a paused state and should not respond to their
+ command. }
+
+type
+ {#Z+}
+ PStatus = ^TStatus;
+ {#Z-}
+ TStatus = Object(TParamText)
+ { TStatus is the base object type from which all status views descend.
+ Status views are used to display information that will change at
+ run-time based upon some state or process in the application, such as
+ printing.
+
+ All status views that are to be inserted into the application should
+ descend from #TAppStatus# for proper color mapping. }
+ Command : Word;
+ { Command is the only command the status view will respond to. When
+ the status view receives an evStatus event it checks the value of the
+ Event.Command field against Command before handling the event. }
+ {#X HandleEvent }
+ constructor Init (R : TRect; ACommand : Word; AText : String;
+ AParamCount : Integer);
+ { Init calls the inherited constructor then sets #Command# to ACommand.
+
+ If an error occurs Init fails. }
+ {#X Load }
+ constructor Load (var S : TStream);
+ { Load calls the inherited constructor then reads #Command# from the
+ stream.
+
+ If an error occurs Load fails. }
+ {#X Store Init }
+ function Cancel : Boolean; virtual;
+ { Cancel should prompt the user when necessary for validation of
+ canceling the process which the status view is displaying. If the
+ user elects to continue the process Cancel must return False,
+ otherwise Cancel must return True. }
+ {#X Pause Resume }
+ function GetPalette : PPalette; virtual;
+ { GetPalette returns a pointer to the default status view palette,
+ #CStatus#. }
+ {#X TAppStatus CAppStatus }
+ procedure HandleEvent (var Event : TEvent); virtual;
+ { HandleEvent captures any #evStatus# messages with its command value
+ equal to #Command#, then calls #Update# with Data set to
+ Event.InfoPtr. If the State field has its #sfPause# bit set, the
+ view ignores the event. }
+ procedure Pause; virtual;
+ { Pause sends an evStatus message to the application with Event.Command
+ set to cmStatusPause and Event.InfoPtr set to #Status#^.Command. The
+ #Status# view's sfPause bit of the State flag is set by calling
+ SetState. In the paused state, the status view does not respond to
+ its associated command. }
+ {#X Resume sdXXXX Cancel }
+ procedure Reset; virtual;
+ { Reset causes the status view to be reset to its beginning or default
+ value, then be redrawn. Reset is used after an event is aborted
+ which can only be performed in its entirety. }
+ procedure Resume; virtual;
+ { Resume is called in response to pressing the Resume button. Resume
+ sends an evStatus message to the application with Event.Command set
+ to cmStatusPause and Event.InfoPtr set to #Status#^.Command. The
+ Status view's sfPause bit is turned off by calling SetState. }
+ {#X Pause sdXXXX Cancel }
+ procedure Store (var S : TStream); { store should never be virtual;}
+ { Store calls the inherited Store method then writes #Command# to the
+ stream. }
+ {#X Load }
+ procedure Update (Data : Pointer); virtual;
+ { Update changes the status' displayed text as necessary based on
+ Data. }
+ {#X Command HandleEvent }
+ end; { of TStatus }
+
+
+ {#Z+}
+ PStatusDlg = ^TStatusDlg;
+ {#Z-}
+ TStatusDlg = Object(TDialog)
+ { A TStatusDlg displays a status view and optional buttons. It may be
+ used to display any status message and optionally provide end user
+ cancelation or pausing of an ongoing operation, such as printing.
+
+ All status views that are to be inserted into a window or dialog should
+ descend from #TStatus# for proper color mapping. }
+ Status : PStatus;
+ { Status is the key status view for the dialog. When a cmStatusPause
+ command is broadcast in response to pressing the pause button,
+ Event.InfoPtr is set to point to the command associated with Status. }
+ {#X TStatus cmXXXX }
+ constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word);
+ { Init calls the inherited constructor to create the dialog and sets
+ the EventMask to handle #evStatus# events. AStatus is assigned to
+ #Status# and inserted into the dialog at position 2,2.
+
+ The dialog is anchored at AStatus^.Origin and its size is at least
+ AStatus^.Size + 2 in both dimensions. The actual size is determined
+ by the AFlags byte. The #sdXXXX# constants should be used to signify
+ which buttons to display.
+
+ If an error occurs Init fails. }
+ {#X TStatus.Pause TStatus.Resume }
+ constructor Load (var S : TStream);
+ { Load calls the inherited constructor then loads #Status#.
+
+ If an error occurs Load fails. }
+ {#X Store }
+ procedure Cancel (ACommand : Word); virtual;
+ { Cancel sends an evStatus message to the Application object with
+ command set to cmCancel and InfoPtr set to the calling status view's
+ command, then calls the inherited Cancel method. }
+ {#X TBSDDialog.Cancel }
+ procedure HandleEvent (var Event : TEvent); virtual;
+ { All evStatus events are accepted by the dialog and sent to each
+ subview in Z-order until cleared.
+
+ If the dialog recieves an evCommand or evBroadcast event with the
+ Command parameter set to cmCancel, HandleEvent sends an #evStatus#
+ message to the Application variable with Event.Command set to the
+ cmStatusCancel and Event.InfoPtr set to the #Status#.Command and
+ disposes of itself.
+
+ When a pause button is included, a cmStatusPause broadcast event is
+ associated with the button. When the button is pressed a call to
+ #TStatus.Pause# results. The status view is inactivated until it
+ receives an evStatus event with a commond of cmStatusResume and
+ Event.InfoPtr set to the status view's Command value. When a pause
+ button is used, the application should respond to the evStatus event
+ (with Event.Command of cmStatusPause) appropriately, then dispatch a
+ cmStatusResume evStatus event when ready to resume activity. }
+ {#X TStatus.Command }
+ procedure InsertButtons (AFlags : Word); virtual;
+ { InsertButtons enlarges the dialog to the necessary size and inserts
+ the buttons specified in AFlags into the last row of the dialog. }
+ procedure Store (var S : TStream); { store should never be virtual;}
+ { Store calls the inherited Store method then writes #Status# to the
+ stream. }
+ {#X Load }
+ end; { of TStatusDlg }
+
+
+ {#Z+}
+ PStatusMessageDlg = ^TStatusMessageDlg;
+ {#Z-}
+ TStatusMessageDlg = Object(TStatusDlg)
+ { A TStatusMessageDlg displays a message as static text with a status
+ view on the line below it.
+
+ All status views that are to be inserted into a window or dialog should
+ descend from #TStatus# for proper color mapping. }
+ constructor Init (ATitle : TTitleStr; AStatus : PStatus; AFlags : Word;
+ AMessage : String);
+ { Init calls the inherited constructor then inserts a TStaticText view
+ containing AMessage at the top line of the dialog.
+
+ The size of the dialog is determined by the size of the AStatus. The
+ dialog is anchored at AStatus^.Origin and is of at least
+ AStatus^.Size + 2 in heighth and width. The exact width and heighth
+ are determined by AOptions.
+
+ AFlags contains flags which determine the buttons to be displayed
+ in the dialog.
+
+ If an error occurs Init fails. }
+ end; { of TStatusMessageDlg }
+
+
+ {#Z+}
+ PGauge = ^TGauge;
+ {#Z-}
+ TGauge = Object(TStatus)
+ { A gauge is used to represent the current numerical position within a
+ range of values. When Current equals Max a gauge dispatches an
+ #evStatus# event with the command set to cmStatusDone to the
+ Application object. }
+ Min : LongInt;
+ { Min is the minimum value which #Current# may be set to. }
+ {#X Max }
+ Max : LongInt;
+ { Max is the maximum value which #Current# may be set to. }
+ {#X Min }
+ Current : LongInt;
+ { Current is the current value represented in the gauge. }
+ {#X Max Min }
+ constructor Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+ { Init calls the inherited constructor then sets #Min# and #Max# to
+ AMin and AMax, respectively. #Current# is set to AMin.
+
+ If an error occurs Init fails. }
+ {#X Load }
+ constructor Load (var S : TStream);
+ { Load calls the inherited constructor then reads #Min#, #Max# and
+ #Current# from the stream.
+
+ If an error occurs Load fails. }
+ {#X Init Store }
+ procedure Draw; virtual;
+ { Draw writes the following to the screen: }
+{#F+}
+{
+Min = XXX Max = XXX Current = XXX }
+{#F-}
+ { where XXX are the current values of the corresponding variables. }
+ procedure GetData (var Rec); virtual;
+ { GetData assumes Rec is a #TGaugeRec# and returns the current settings
+ of the gauge. }
+ {#X SetData }
+ procedure Reset; virtual;
+ { Reset sets #Current# to #Min# then redraws the status view. }
+ {#X TStatus.Reset }
+ procedure SetData (var Rec); virtual;
+ { SetData assumes Rec is a #TGaugeRec# and sets the gauge's variables
+ accordingly. }
+ {#X GetData }
+ procedure Store (var S : TStream); { store should never be virtual;}
+ { Store calls the inherited Store method then writes #Min#, #Max# and
+ #Current# to the stream. }
+ {#X Load }
+ procedure Update (Data : Pointer); virtual;
+ { Update increments #Current#. }
+ end; { of TGauge }
+
+
+ {#Z+}
+ PGaugeRec = ^TGaugeRec;
+ {#Z-}
+ TGaugeRec = record
+ { A TGaugeRec is used to set and get a #TGauge#'s variables. }
+ {#X TGauge.GetData TGauge.SetData }
+ Min, Max, Current : LongInt;
+ end; { of TGaugeRec }
+
+
+ {#Z+}
+ PArrowGauge = ^TArrowGauge;
+ {#Z-}
+ TArrowGauge = Object(TGauge)
+ { An arrow gauge draws a progressively larger series of arrows across the
+ view. If Right is True, the arrows are right facing, '>', and are
+ drawn from left to right. If Right is False, the arrows are left
+ facing, '<', and are drawn from right to left. }
+ Right : Boolean;
+ { Right determines the direction of arrow used and the direction which
+ the status view is filled. If Right is True, the arrows are right
+ facing, '>', and are drawn from left to right. If Right is False,
+ the arrows are left facing, '<', and are drawn from right to left. }
+ {#X Draw }
+ constructor Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+ RightArrow : Boolean);
+ { Init calls the inherited constructor then sets #Right# to RightArrow.
+
+ If an error occurs Init fails. }
+ {#X Load }
+ constructor Load (var S : TStream);
+ { Load calls the inherited constructor then reads #Right# from the
+ stream.
+
+ If an error occurs Load fails. }
+ {#X Init Store }
+ procedure Draw; virtual;
+ { Draw fills the Current / Max percent of the view with arrows. }
+ {#X Right }
+ procedure GetData (var Rec); virtual;
+ { GetData assumes Rec is a #TArrowGaugeRec# and returns the current
+ settings of the views variables. }
+ {#X SetData }
+ procedure SetData (var Rec); virtual;
+ { SetData assumes Rec is a #TArrowGaugeRec# and sets the view's
+ variables accordingly. }
+ {#X GetData }
+ procedure Store (var S : TStream); { store should never be virtual;}
+ { Store calls the inherited Store method then writes #Right# to the
+ stream. }
+ {#X Load }
+ end; { of TArrowGauge }
+
+
+ {#Z+}
+ PArrowGaugeRec = ^TArrowGaugeRec;
+ {#Z-}
+ TArrowGaugeRec = record
+ { A TArrowGaugeRec is used to set and get the variables of a
+ #TArrowGauge#. }
+ {#X TArrowGauge.GetData TArrowGauge.SetData }
+ Min, Max, Count : LongInt;
+ Right : Boolean;
+ end; { of TGaugeRec }
+
+
+ {#Z+}
+ PPercentGauge = ^TPercentGauge;
+ {#Z-}
+ TPercentGauge = Object(TGauge)
+ { A TPercentGauge displays a numerical percentage as returned by
+ #Percent# followed by a '%' sign. }
+ function Percent : Integer; virtual;
+ { Percent returns the whole number value of (Current / Max) * 100. }
+ {#X TGauge.Current TGauge.Max }
+ procedure Draw; virtual;
+ { Draw writes the current percentage to the screen. }
+ {#X Percent }
+ end; { of TPercentGauge }
+
+
+ {#Z+}
+ PBarGauge = ^TBarGauge;
+ {#Z-}
+ TBarGauge = Object(TPercentGauge)
+ { A TBarGauge displays a bar which increases in size from the left to
+ the right of the view as Current increases. A numeric percentage
+ representing the value of (Current / Max) * 100 is displayed in the
+ center of the bar. }
+ {#x TPercentGauge.Percent }
+ procedure Draw; virtual;
+ { Draw draws the bar and percentage to the screen representing the
+ current status of the view's variables. }
+ {#X TGauge.Update }
+ function GetPalette : PPalette; virtual;
+ { GetPalette returns a pointer to the default status view palette,
+ #CBarStatus#. }
+ end; { of TBarGauge }
+
+
+ {#Z+}
+ PSpinnerGauge = ^TSpinnerGauge;
+ {#Z-}
+ TSpinnerGauge = Object(TGauge)
+ { A TSpinnerGauge displays a series of characters in one spot on the
+ screen giving the illusion of a spinning line. }
+ constructor Init (X, Y : Integer; ACommand : Word);
+ { Init calls the inherited constructor with AMin set to 0 and AMax set
+ to 4. }
+ procedure Draw; virtual;
+ { Draw uses the #SpinChars# variable to draw the view's Current
+ character. }
+ {#X Update }
+ procedure HandleEvent (var Event : TEvent); virtual;
+ { HandleEvent calls TStatus.HandleEvent so that a cmStatusDone event
+ is not generated when Current equals Max. }
+ {#X TGauge.Current TGauge.Max }
+ procedure Update (Data : Pointer); virtual;
+ { Update increments Current until Current equals Max, when it resets
+ Current to Min. }
+ {#X Draw HandleEvent }
+ end; { of TSpinnerGauge }
+
+
+ {#Z+}
+ PAppStatus = ^TAppStatus;
+ {#Z-}
+ TAppStatus = Object(TStatus)
+ { TAppStatus is a base object which implements color control for status
+ views that are normally inserted in the Application object. }
+ {#X TStatus }
+ function GetPalette : PPalette; virtual;
+ { GetPalette returns a pointer to the default application status view
+ palette, #CAppStatus#. }
+ {#X TStatus CStatus }
+ end; { of TAppStatus }
+
+
+ {#Z+}
+ PHeapMaxAvail = ^THeapMaxAvail;
+ {#Z-}
+ THeapMaxAvail = Object(TAppStatus)
+ { A THeapMaxAvail displays the largest available contiguous area of heap
+ memory. It responds to a cmStatusUpdate event by calling MaxAvail and
+ comparing the result to #Max#, then updating the view if necessary. }
+ {#X THeapMemAvail }
+ constructor Init (X, Y : Integer);
+ { Init creates the view with the following text:
+
+ MaxAvail = xxxx
+
+ where xxxx is the result returned by MaxAvail. }
+ procedure Update (Data : Pointer); virtual;
+ { Update changes #Mem# to the current MemAvail and redraws the status
+ if necessary. }
+ private
+ Max : LongInt;
+ { Max is the last reported value from MaxAvail. }
+ {#X Update }
+ end; { of THeapMaxAvail }
+
+
+ {#Z+}
+ PHeapMemAvail = ^THeapMemAvail;
+ {#Z-}
+ THeapMemAvail = Object(TAppStatus)
+ { A THeapMemAvail displays the total amount of heap memory available to
+ the application. It responds to a cmStatusUpdate event by calling
+ MemAvail and comparing the result to #Max#, then updating the view if
+ necessary. }
+ {#X THeapMaxAvail }
+ constructor Init (X, Y : Integer);
+ { Init creates the view with the following text:
+
+ MemAvail = xxxx
+
+ where xxxx is the result returned by MemAvail. }
+ {#X Load }
+ procedure Update (Data : Pointer); virtual;
+ { Update changes #Mem# to the current MemAvail and redraws the status
+ if necessary. }
+ private
+ Mem : LongInt;
+ { Mem is the last available value reported by MemAvail. }
+ {#X Update }
+ end; { of THeapMemAvail }
+
+
+{$ifndef cdPrintDoc}
+{#Z+}
+{$endif cdPrintDoc}
+const
+ RStatus : TStreamRec = (
+ ObjType : idStatus;
+ VmtLink : Ofs(TypeOf(TStatus)^);
+ Load : @TStatus.Load;
+ Store : @TStatus.Store);
+
+ RStatusDlg : TStreamRec = (
+ ObjType : idStatusDlg;
+ VmtLink : Ofs(TypeOf(TStatusDlg)^);
+ Load : @TStatusDlg.Load;
+ Store : @TStatusDlg.Store);
+
+ RStatusMessageDlg : TStreamRec = (
+ ObjType : idStatusMessageDlg;
+ VmtLink : Ofs(TypeOf(TStatusMessageDlg)^);
+ Load : @TStatusMessageDlg.Load;
+ Store : @TStatusMessageDlg.Store);
+
+ RGauge : TStreamRec = (
+ ObjType : idGauge;
+ VmtLink : Ofs(TypeOf(TGauge)^);
+ Load : @TGauge.Load;
+ Store : @TGauge.Store);
+
+ RArrowGauge : TStreamRec = (
+ ObjType : idArrowGauge;
+ VmtLink : Ofs(TypeOf(TArrowGauge)^);
+ Load : @TArrowGauge.Load;
+ Store : @TArrowGauge.Store);
+
+ RBarGauge : TStreamRec = (
+ ObjType : idBarGauge;
+ VmtLink : Ofs(TypeOf(TBarGauge)^);
+ Load : @TBarGauge.Load;
+ Store : @TBarGauge.Store);
+
+ RPercentGauge : TStreamRec = (
+ ObjType : idPercentGauge;
+ VmtLink : Ofs(TypeOf(TPercentGauge)^);
+ Load : @TPercentGauge.Load;
+ Store : @TPercentGauge.Store);
+
+ RSpinnerGauge : TStreamRec = (
+ ObjType : idSpinnerGauge;
+ VmtLink : Ofs(TypeOf(TSpinnerGauge)^);
+ Load : @TSpinnerGauge.Load;
+ Store : @TSpinnerGauge.Store);
+
+ RAppStatus : TStreamRec = (
+ ObjType : idAppStatus;
+ VmtLink : Ofs(TypeOf(TAppStatus)^);
+ Load : @TAppStatus.Load;
+ Store : @TAppStatus.Store);
+
+ RHeapMinAvail : TStreamRec = (
+ ObjType : idHeapMinAvail;
+ VmtLink : Ofs(TypeOf(THeapMaxAvail)^);
+ Load : @THeapMaxAvail.Load;
+ Store : @THeapMaxAvail.Store);
+
+ RHeapMemAvail : TStreamRec = (
+ ObjType : idHeapMemAvail;
+ VmtLink : Ofs(TypeOf(THeapMemAvail)^);
+ Load : @THeapMemAvail.Load;
+ Store : @THeapMemAvail.Store);
+{$ifndef cdPrintDoc}
+{#Z-}
+{$endif cdPrintDoc}
+
+procedure RegisterStatuses;
+{$ifndef cdPrintDoc}
+{#F+}
+{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
+ÝRegisterStatuses procedure (Statuses unit)Þ
+ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
+{#F-}
+{$endif cdPrintDoc}
+ { RegisterStatuses calls RegisterType for each of the status view and
+ status dialog object types defined in the tvStatus unit. After calling
+ RegisterStatuses, your application can read or write any of those types
+ with streams. }
+
+
+implementation
+
+uses
+ MsgBox, App;
+
+{****************************************************************************}
+{ Local procedures and functions }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TAppStatus Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TAppStatus.GetPalette }
+{****************************************************************************}
+function TAppStatus.GetPalette : PPalette;
+const P : String[Length(CAppStatus)] = CAppStatus;
+begin
+ GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TArrowGauge Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TArrowGauge.Init }
+{****************************************************************************}
+constructor TArrowGauge.Init (R : TRect; ACommand : Word; AMin, AMax : Word;
+ RightArrow : Boolean);
+begin
+ if not TGauge.Init(R,ACommand,AMin,AMax) then
+ Fail;
+ Right := RightArrow;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Load }
+{****************************************************************************}
+constructor TArrowGauge.Load (var S : TStream);
+begin
+ if not TGauge.Load(S) then
+ Fail;
+ S.Read(Right,SizeOf(Right));
+ if (S.Status <> stOk) then
+ begin
+ TGauge.Done;
+ Fail;
+ end;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Draw }
+{****************************************************************************}
+procedure TArrowGauge.Draw;
+const Arrows : array[0..1] of Char = '<>';
+var
+ B : TDrawBuffer;
+ C : Word;
+ Len : Byte;
+begin
+ C := GetColor(1);
+ Len := Round(Size.X * Current/(Max - Min));
+ MoveChar(B,' ',C,Size.X);
+ if Right then
+ MoveChar(B,Arrows[Byte(Right)],C,Len)
+ else MoveChar(B[Size.X - Len],Arrows[Byte(Right)],C,Len);
+ WriteLine(0,0,Size.X,1,B);
+end;
+
+{****************************************************************************}
+{ TArrowGauge.GetData }
+{****************************************************************************}
+procedure TArrowGauge.GetData (var Rec);
+begin
+ PArrowGaugeRec(Rec)^.Min := Min;
+ PArrowGaugeRec(Rec)^.Max := Max;
+ PArrowGaugeRec(Rec)^.Count := Current;
+ PArrowGaugeRec(Rec)^.Right := Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.SetData }
+{****************************************************************************}
+procedure TArrowGauge.SetData (var Rec);
+begin
+ Min := PArrowGaugeRec(Rec)^.Min;
+ Max := PArrowGaugeRec(Rec)^.Max;
+ Current := PArrowGaugeRec(Rec)^.Count;
+ Right := PArrowGaugeRec(Rec)^.Right;
+end;
+
+{****************************************************************************}
+{ TArrowGauge.Store }
+{****************************************************************************}
+procedure TArrowGauge.Store (var S : TStream);
+begin
+ TGauge.Store(S);
+ S.Write(Right,SizeOf(Right));
+end;
+
+{****************************************************************************}
+{ TBarGauge Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TBarGauge.Draw }
+{****************************************************************************}
+procedure TBarGauge.Draw;
+var
+ B : TDrawBuffer;
+ C : Word;
+ FillSize : Word;
+ PercentDone : LongInt;
+ S : String[4];
+begin
+ { fill entire view }
+ MoveChar(B,' ',GetColor(4),Size.X);
+ { make progress bar }
+ C := GetColor(5);
+ FillSize := Round(Size.X * (Current / Max));
+ MoveChar(B,' ',C,FillSize);
+ { display percent done }
+ PercentDone := Percent;
+ FormatStr(S,'%d%%',PercentDone);
+ if PercentDone < 50 then
+ C := GetColor(4);
+ FillSize := (Size.X - Length(S)) div 2;
+ MoveStr(B[FillSize],S,C);
+ WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TBarGauge.GetPalette }
+{****************************************************************************}
+function TBarGauge.GetPalette : PPalette;
+const
+ S : String[Length(CBarGauge)] = CBarGauge;
+begin
+ GetPalette := PPalette(@S);
+end;
+
+{****************************************************************************}
+{ TGauge Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TGauge.Init }
+{****************************************************************************}
+constructor TGauge.Init (R : TRect; ACommand : Word; AMin, AMax : LongInt);
+begin
+ if not TStatus.Init(R,ACommand,'',1) then
+ Fail;
+ Min := AMin;
+ Max := AMax;
+ Current := Min;
+end;
+
+{****************************************************************************}
+{ TGauge.Load }
+{****************************************************************************}
+constructor TGauge.Load (var S : TStream);
+begin
+ if not TStatus.Load(S) then
+ Fail;
+ S.Read(Min,SizeOf(Min));
+ S.Read(Max,SizeOf(Max));
+ S.Read(Current,SizeOf(Current));
+ if S.Status <> stOk then
+ begin
+ TStatus.Done;
+ Fail;
+ end;
+end;
+
+{****************************************************************************}
+{ TGauge.Draw }
+{****************************************************************************}
+procedure TGauge.Draw;
+var
+ S : String;
+ B : TDrawBuffer;
+begin
+ { Blank the gauge }
+ MoveChar(B,' ',GetColor(1),Size.X);
+ WriteBuf(0,0,Size.X,Size.Y,B);
+ { write current status }
+ FormatStr(S,'%d',Current);
+ MoveStr(B,S,GetColor(1));
+ WriteBuf(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TGauge.GetData }
+{****************************************************************************}
+procedure TGauge.GetData (var Rec);
+begin
+ TGaugeRec(Rec).Min := Min;
+ TGaugeRec(Rec).Max := Max;
+ TGaugeRec(Rec).Current := Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Reset }
+{****************************************************************************}
+procedure TGauge.Reset;
+begin
+ Current := Min;
+ DrawView;
+end;
+
+{****************************************************************************}
+{ TGauge.SetData }
+{****************************************************************************}
+procedure TGauge.SetData (var Rec);
+begin
+ Min := TGaugeRec(Rec).Min;
+ Max := TGaugeRec(Rec).Max;
+ Current := TGaugeRec(Rec).Current;
+end;
+
+{****************************************************************************}
+{ TGauge.Store }
+{****************************************************************************}
+procedure TGauge.Store (var S : TStream);
+begin
+ TStatus.Store(S);
+ S.Write(Min,SizeOf(Min));
+ S.Write(Max,SizeOf(Max));
+ S.Write(Current,SizeOf(Current));
+end;
+
+{****************************************************************************}
+{ TGauge.Update }
+{****************************************************************************}
+procedure TGauge.Update (Data : Pointer);
+begin
+ if Current < Max then
+ begin
+ Inc(Current);
+ DrawView;
+ end
+ else Message(@Self,evStatus,cmStatusDone,@Self);
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail Object }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMaxAvail.Init }
+{****************************************************************************}
+constructor THeapMaxAvail.Init (X, Y : Integer);
+var
+ R : TRect;
+begin
+ R.Assign(X,Y,X+20,Y+1);
+ if not TAppStatus.Init(R,cmStatusUpdate,' MaxAvail = %d',1) then
+ Fail;
+ Max := -1;
+end;
+
+{****************************************************************************}
+{ THeapMaxAvail.Update }
+{****************************************************************************}
+procedure THeapMaxAvail.Update (Data : Pointer);
+var
+ M : LongInt;
+begin
+ M := MaxAvail;
+ if (Max <> M) then
+ begin
+ Max := MaxAvail;
+ SetData(Max);
+ end;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail Object }
+{****************************************************************************}
+{****************************************************************************}
+{ THeapMemAvail.Init }
+{****************************************************************************}
+constructor THeapMemAvail.Init (X, Y : Integer);
+var
+ R : TRect;
+begin
+ R.Assign(X,Y,X+20,Y+1);
+ if not TAppStatus.Init(R,cmStatusUpdate,' MemAvail = %d',1) then
+ Fail;
+ Mem := -1;
+end;
+
+{****************************************************************************}
+{ THeapMemAvail.Update }
+{****************************************************************************}
+procedure THeapMemAvail.Update (Data : Pointer);
+ { Total bytes available on the heap. May not be contiguous. }
+var
+ M : LongInt;
+begin
+ M := MemAvail;
+ if (Mem <> M) then
+ begin
+ Mem := M;
+ SetData(Mem);
+ end;
+end;
+
+{****************************************************************************}
+{ TPercentGauge Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TPercentGauge.Draw }
+{****************************************************************************}
+procedure TPercentGauge.Draw;
+var
+ B : TDrawBuffer;
+ C : Word;
+ S : String;
+ PercentDone : LongInt;
+ FillSize : Integer;
+begin
+ C := GetColor(1);
+ MoveChar(B,' ',C,Size.X);
+ WriteLine(0,0,Size.X,Size.Y,B);
+ PercentDone := Percent;
+ FormatStr(S,'%d%%',PercentDone);
+ MoveStr(B[(Size.X - Byte(S[0])) div 2],S,C);
+ WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TPercentGauge.Percent }
+{****************************************************************************}
+function TPercentGauge.Percent : Integer;
+ { Returns percent as a whole integer Current of Max }
+begin
+ Percent := Round((Current/Max) * 100);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge Object }
+{****************************************************************************}
+
+{****************************************************************************}
+{ TSpinnerGauge.Init }
+{****************************************************************************}
+constructor TSpinnerGauge.Init (X, Y : Integer; ACommand : Word);
+var R : TRect;
+begin
+ R.Assign(X,Y,X+1,Y+1);
+ if not TGauge.Init(R,ACommand,1,4) then
+ Fail;
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Draw }
+{****************************************************************************}
+procedure TSpinnerGauge.Draw;
+var
+ B : TDrawBuffer;
+ C : Word;
+begin
+ C := GetColor(1);
+ MoveChar(B,' ',C,Size.X);
+ WriteLine(0,0,Size.X,Size.Y,B);
+ MoveChar(B[Size.X div 2],SpinChars[Current],C,1);
+ WriteLine(0,0,Size.X,Size.Y,B);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.HandleEvent }
+{****************************************************************************}
+procedure TSpinnerGauge.HandleEvent (var Event : TEvent);
+begin
+ TStatus.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TSpinnerGauge.Update }
+{****************************************************************************}
+procedure TSpinnerGauge.Update (Data : Pointer);
+begin
+ if Current = Max then
+ Current := Min
+ else Inc(Current);
+ DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatus.Init }
+{****************************************************************************}
+constructor TStatus.Init (R : TRect; ACommand : Word; AText : String;
+ AParamCount : Integer);
+begin
+ if (not TParamText.Init(R,AText,AParamCount)) then
+ Fail;
+ EventMask := EventMask or evStatus;
+ Command := ACommand;
+end;
+
+{****************************************************************************}
+{ TStatus.Load }
+{****************************************************************************}
+constructor TStatus.Load (var S : TStream);
+begin
+ if not TParamText.Load(S) then
+ Fail;
+ S.Read(Command,SizeOf(Command));
+ if (S.Status <> stOk) then
+ begin
+ TParamText.Done;
+ Fail;
+ end;
+end;
+
+{****************************************************************************}
+{ TStatus.Cancel }
+{****************************************************************************}
+function TStatus.Cancel : Boolean;
+begin
+ Cancel := True;
+end;
+
+{****************************************************************************}
+{ TStatus.GetPalette }
+{****************************************************************************}
+function TStatus.GetPalette : PPalette;
+const
+ P : String[Length(CStatus)] = CStatus;
+begin
+ GetPalette := PPalette(@P);
+end;
+
+{****************************************************************************}
+{ TStatus.HandleEvent }
+{****************************************************************************}
+procedure TStatus.HandleEvent (var Event : TEvent);
+begin
+ if (Event.What = evCommand) and (Event.Command = cmStatusPause) then
+ begin
+ Pause;
+ ClearEvent(Event);
+ end;
+ case Event.What of
+ evStatus :
+ case Event.Command of
+ cmStatusDone :
+ if (Event.InfoPtr = @Self) then
+ begin
+ Message(Owner,evStatus,cmStatusDone,@Self);
+ ClearEvent(Event);
+ end;
+ cmStatusUpdate :
+ if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+ begin
+ Update(Event.InfoPtr);
+ { ClearEvent(Event); } { don't clear the event so multiple }
+ { status views can respond to the same event }
+ end;
+ cmStatusResume :
+ if (Event.InfoWord = Command) and
+ ((State and sfPause) = sfPause) then
+ begin
+ Resume;
+ ClearEvent(Event);
+ end;
+ cmStatusPause :
+ if (Event.InfoWord = Command) and ((State and sfPause) = 0) then
+ begin
+ Pause;
+ ClearEvent(Event);
+ end;
+ end;
+ end;
+ TParamText.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatus.Pause }
+{****************************************************************************}
+procedure TStatus.Pause;
+begin
+ SetState(sfPause,True);
+end;
+
+{****************************************************************************}
+{ TStatus.Reset }
+{****************************************************************************}
+procedure TStatus.Reset;
+begin
+ DrawView;
+end;
+
+{****************************************************************************}
+{ TStatus.Resume }
+{****************************************************************************}
+procedure TStatus.Resume;
+begin
+ SetState(sfPause,False);
+end;
+
+{****************************************************************************}
+{ TStatus.Store }
+{****************************************************************************}
+procedure TStatus.Store (var S : TStream);
+begin
+ TParamText.Store(S);
+ S.Write(Command,SizeOf(Command));
+end;
+
+{****************************************************************************}
+{ TStatus.Update }
+{****************************************************************************}
+procedure TStatus.Update (Data : Pointer);
+begin
+ DisposeStr(Text);
+ Text := NewStr(String(Data^));
+ DrawView;
+end;
+
+{****************************************************************************}
+{ TStatusDlg Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusDlg.Init }
+{****************************************************************************}
+constructor TStatusDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+ AFlags : Word);
+var
+ R : TRect;
+ i : LongInt;
+ Buttons : Byte;
+begin
+ if (AStatus = nil) then
+ Fail;
+ R.A := AStatus^.Origin;
+ R.B := AStatus^.Size;
+ Inc(R.B.Y,R.A.Y+4);
+ Inc(R.B.X,R.A.X+5);
+ if not TDialog.Init(R,ATitle) then
+ Fail;
+ EventMask := EventMask or evStatus;
+ Status := AStatus;
+ Status^.MoveTo(2,2);
+ Insert(Status);
+ InsertButtons(AFlags);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Load }
+{****************************************************************************}
+constructor TStatusDlg.Load (var S : TStream);
+begin
+ if not TDialog.Load(S) then
+ Fail;
+ GetSubViewPtr(S,Status);
+ if (S.Status <> stOk) then
+ begin
+ if (Status <> nil) then
+ Dispose(Status,Done);
+ TDialog.Done;
+ Fail;
+ end;
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Cancel }
+{****************************************************************************}
+procedure TStatusDlg.Cancel (ACommand : Word);
+begin
+ if Status^.Cancel then
+ TDialog.Cancel(ACommand);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.HandleEvent }
+{****************************************************************************}
+procedure TStatusDlg.HandleEvent (var Event : TEvent);
+begin
+ case Event.What of
+ evStatus :
+ case Event.Command of
+ cmStatusDone :
+ if Event.InfoPtr = Status then
+ begin
+ TDialog.Cancel(cmOk);
+ ClearEvent(Event);
+ end;
+ end;
+ { else let TDialog.HandleEvent send to all subviews for handling }
+ evBroadcast, evCommand :
+ case Event.Command of
+ cmCancel, cmClose :
+ begin
+ Cancel(cmCancel);
+ ClearEvent(Event);
+ end;
+ cmStatusPause :
+ begin
+ Status^.Pause;
+ ClearEvent(Event);
+ end;
+ cmStatusResume :
+ begin
+ Status^.Resume;
+ ClearEvent(Event);
+ end;
+ end;
+ end;
+ TDialog.HandleEvent(Event);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.InsertButtons }
+{****************************************************************************}
+procedure TStatusDlg.InsertButtons (AFlags : Word);
+var
+ R : TRect;
+ P : PButton;
+ Buttons : Byte;
+ X, Y, Gap : Integer;
+ i : Word;
+begin
+ Buttons := Byte(((AFlags and sdCancelButton) = sdCancelButton));
+ { do this Inc twice, once for Pause and once for Resume buttons }
+ Inc(Buttons,2 * Byte(((AFlags and sdPauseButton) = sdPauseButton)));
+ if Buttons > 0 then
+ begin
+ Status^.GrowMode := gfGrowHiX;
+ { resize dialog to hold all requested buttons }
+ if Size.X < ((Buttons * 12) + 2) then
+ GrowTo((Buttons * 12) + 2,Size.Y + 2)
+ else GrowTo(Size.X,Size.Y + 2);
+ { find correct starting position for first button }
+ Gap := Size.X - (Buttons * 10) - 2;
+ Gap := Gap div Succ(Buttons);
+ X := Gap;
+ if X < 2 then
+ X := 2;
+ Y := Size.Y - 3;
+ { insert buttons }
+ if ((AFlags and sdCancelButton) = sdCancelButton) then
+ begin
+ P := NewButton(X,Y,10,2,'Cancel',cmCancel,hcCancel,bfDefault);
+ P^.GrowMode := gfGrowHiY or gfGrowLoY;
+ Inc(X,12 + Gap);
+ end;
+ if ((AFlags and sdPauseButton) = sdPauseButton) then
+ begin
+ P := NewButton(X,Y,10,2,'~P~ause',cmStatusPause,hcStatusPause,bfNormal);
+ P^.GrowMode := gfGrowHiY or gfGrowLoY;
+ Inc(X,12 + Gap);
+ P := NewButton(X,Y,10,2,'~R~esume',cmStatusResume,hcStatusResume,
+ bfBroadcast);
+ P^.GrowMode := gfGrowHiY or gfGrowLoY;
+ end;
+ end; { of if }
+ SelectNext(False);
+end;
+
+{****************************************************************************}
+{ TStatusDlg.Store }
+{****************************************************************************}
+procedure TStatusDlg.Store (var S : TStream);
+begin
+ TDialog.Store(S);
+ PutSubViewPtr(S,Status);
+end;
+
+{****************************************************************************}
+{ TStatusMessageDlg Object }
+{****************************************************************************}
+{****************************************************************************}
+{ TStatusMessageDlg.Init }
+{****************************************************************************}
+constructor TStatusMessageDlg.Init (ATitle : TTitleStr; AStatus : PStatus;
+ AFlags : Word; AMessage : String);
+var
+ P : PStaticText;
+ X, Y : Integer;
+ R : TRect;
+begin
+ if not TStatusDlg.Init(ATitle,AStatus,AFlags) then
+ Fail;
+ Status^.GrowMode := gfGrowLoY or gfGrowHiY;
+ GetExtent(R);
+ X := R.B.X - R.A.X;
+ if X < Size.X then
+ X := Size.X;
+ Y := R.B.Y - R.A.Y;
+ if Y < Size.Y then
+ Y := Size.Y;
+ GrowTo(X,Y);
+ R.Assign(2,2,Size.X-2,Size.Y-3);
+ P := New(PStaticText,Init(R,AMessage));
+ if (P = nil) then
+ begin
+ TStatusDlg.Done;
+ Fail;
+ end;
+ GrowTo(Size.X,Size.Y + P^.Size.Y + 1);
+ Insert(P);
+end;
+
+{****************************************************************************}
+{ Global procedures and functions }
+{****************************************************************************}
+
+{****************************************************************************}
+{ RegisterStatuses }
+{****************************************************************************}
+procedure RegisterStatuses;
+begin
+{ RegisterType(RStatus);
+ RegisterType(RStatusDlg);
+ RegisterType(RGauge);
+ RegisterType(RArrowGauge);
+ RegisterType(RPercentGauge);
+ RegisterType(RBarGauge);
+ RegisterType(RSpinnerGauge); }
+end;
+
+{****************************************************************************}
+{ Unit Initialization }
+{****************************************************************************}
+begin
+end.
View Lorry Controller Status